Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 13:07:28

chris58

Hallo Spezialisten !
Ich bin erst heute darauf gestoßen. Ich habe in meine Datei einen Suchen-Button. Mit diesem habe ich heute folgendes gesucht .............
alle Zeilen die .........Freitag stehen haben (die Tage stehen in Spalte M).
Der Code listet mir nun alle Zeilen in einem neuen Tabellenblatt auf.
Es wird jedoch in diesem Fall ab 06.09.2024 zwar der richtige Tag, jedoch Samstag angegeben, obwohl es doch ein Freitag ist.
Woran kann das liegen. Ich habe die Datei mit dem Code angehängt.
Danke für die Hilfe
chris58

https://www.herber.de/bbs/user/175673.xls

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 13:28:31

Crazy Tom

moin,

wenn du die absolute ($) Adressierung im Blatt Berechnung in relative änderst dann kommt überall der Freitag raus

mfg Tom

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 15:39:18

Alwin Weisangler

Hallo Chris,

setzte in dieser Spalte einfach keine Formel, wenn der Eintrag sowieso per Userform passiert. Die Ausgabe kannst du doch aus der Textbox (Datum für Zellen der Spalte A) beispielsweise .Cells(deine Zeile,13) = Format(CDate(TextBox1), "dddd") so eintragen und dann klappt es auch mit der Methode .Find.

Gruß Uwe

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

15.02.2025 10:52:27

Alwin Weisangler

Hallo Chris,

Ich hab mir mal die wenig effiziente Suchprozedur angeschaut und das Schreiben ins neue Tabellenblatt so umgebaut, dass nur noch blockweise geschrieben wird.
Damit funktioniert das drastisch schneller.



Private Sub Filter()

    Dim rng As Range

    Dim sFirst As String

    Dim sFind As String

    Dim wks As Worksheet, neu As Worksheet

    Dim Zeilen As String

    sFind = InputBox("Geben sie das gesuchte Wort oder" & vbLf & "den gesuchten Wortteil ein:", "Suchen", "Suchbegriff")

    If sFind = "" Then Exit Sub

    Application.ScreenUpdating = False

    Set neu = Worksheets.Add(before:=Sheets(1))

    neu.Name = "Suche " & Format(Now, "dd.mm.yy")

    For Each wks In ThisWorkbook.Sheets

        If wks.Name > neu.Name Then

            Set rng = wks.Cells.Find(What:=sFind, LookIn:=xlValues, LookAt:=xlPart)

            If Not rng Is Nothing Then

                sFirst = rng.Address

                Do

                    If Len(Zeilen)  220 Then

                        Zeilen = Zeilen & rng.Row & ":" & rng.Row & ","

                    Else

                        Zeilen = Zeilen & rng.Row & ":" & rng.Row & ","

                        wks.Range(Left(Zeilen, Len(Zeilen) - 1)).Copy neu.Cells(neu.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)

                        Zeilen = ""

                    End If

                    Set rng = wks.Cells.FindNext(rng)

                Loop While rng.Address > sFirst

            End If

        End If

        If Zeilen > "" Then wks.Range(Left(Zeilen, Len(Zeilen) - 1)).Copy neu.Cells(neu.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)

        Zeilen = ""

        Set rng = Nothing

    Next

End Sub

In den Formeln muss du die absolute Zelladresse $ entfernen um eine relative Zelladresse zu erhalten, oder so wie ich bereits geschrieben hatte, einfach da eh schon teilweise vorhanden ohne Formel die Wochentagsnamen aus der Textbox übernehmen.

Gruß Uwe

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

15.02.2025 20:16:51

Alwin Weisangler

kleine Korrektur, um das mehrmalige Einlesen einer Zeilennummer zu verhindern:



Private Sub Filter()

    Dim rng As Range

    Dim sFirst As String

    Dim sFind As String

    Dim wks As Worksheet, neu As Worksheet

    Dim Zeilen As String

    sFind = InputBox("Geben sie das gesuchte Wort oder" & vbLf & "den gesuchten Wortteil ein:", "Suchen", "Suchbegriff")

    If sFind = "" Then Exit Sub

    Set neu = Worksheets.Add(before:=Sheets(1))

    neu.Name = "Suche " & Format(Now, "dd.mm.yy")

    Application.ScreenUpdating = False

    For Each wks In ThisWorkbook.Sheets

        If wks.Name > neu.Name Then

            Set rng = wks.Cells.Find(What:=sFind, LookIn:=xlValues, LookAt:=xlPart)

            If Not rng Is Nothing Then

                sFirst = rng.Address

                Do

                    If Len(Zeilen)  210 Then

                        If InStr(1, Zeilen, rng.Row & ":" & rng.Row, vbTextCompare) = 0 Then Zeilen = Zeilen & rng.Row & ":" & rng.Row & ","    ' Bedingung keine Doppelte Zeilennummern

                    Else

                        If InStr(1, Zeilen, rng.Row & ":" & rng.Row, vbTextCompare) = 0 Then Zeilen = Zeilen & rng.Row & ":" & rng.Row & ","    ' Bedingung keine Doppelte Zeilennummern

                        wks.Range(Left(Zeilen, Len(Zeilen) - 1)).Copy neu.Cells(neu.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)

                        Zeilen = ""

                    End If

                    Set rng = wks.Cells.FindNext(rng)

                Loop While rng.Address > sFirst

            End If

        End If

        If Zeilen > "" Then wks.Range(Left(Zeilen, Len(Zeilen) - 1)).Copy neu.Cells(neu.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)

        Zeilen = ""

        Set rng = Nothing

    Next

End Sub

Gruß Uwe

Danke

16.02.2025 09:26:21

chris58

Danke für den Code zum Suchen.
chris58

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 14:06:43

chris58

Hallo Tom !
Liege ich richtig, das der Code:
R.Cells(13).Formula = "=TEXT(RC[-12],""TTTT"")"

gegen diesen:
R.Cells(13).Formula = "=TEXT(" & R.Cells(1).Address & ",""TTTT"")" 'Formel in Spalte M

ausgetauscht werden muß ?

Ich habe das zwar getestet, doch ob das so stimmt, bin ich mir nicht so sicher.
Danke für Deine Antwort
chris58

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 14:30:28

Crazy Tom

und wo in deiner Datei soll diese Codezeile vorkommen?

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 14:39:12

chris58

Diese Codezeile ist bei der UF die die Daten in die Tabelle einträgt.

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 14:40:27

Crazy Tom

die aber nicht in deiner Datei drin ist?

AW: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

14.02.2025 15:42:11

chris58

Hallo Tom !
Ja, die UF und das andere habe ich herausgenommen, sonst wäre das ja zu groß.
Hier der Teil, wo die Formel drinnensteht, die den Tag einträgt.
Fett hinterlegt, welcher zu tauschen wäre ?????
Kannst mir bitte sagen, ob das so passt, ohne das ich in späterer Folge einen Fehler haben werde ?
Danke
lg chris58

Private Sub CommandButton4_Click()
Dim i, j
Dim R As Range
Const cNeuesBlatt As String = "Berechnung"

'Prüfung. Wenn einer "ist nicht numerisch", dann raus
If (Not IsDate(TextBox3)) Or IstNichtNum(TextBox1) Or IstNichtNum(TextBox4) Or IstNichtNum(TextBox5) Or IstNichtNum(TextBox6) Or IstNichtNum(TextBox7) Then Exit Sub

'Es passiert alle auf ActiveSheet
Cells(6, "B") = CDbl(Format(TextBox1, "#,##0.00"))
Cells(7, "C") = CDate(TextBox3)

Application.ScreenUpdating = False
'Wert zum neuen Blatt übertragen
Set R = Blatt_selektieren(cNeuesBlatt).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow 'nächste leere Zeile ermitteln. R ist eine Zeile.
For Each i In Split("C7 C11 C6 C12 C13 C14")
j = j + 1
R.Cells(j) = Range(i).Value 'Cells(1) von einer Zeile in der Spalte A dieser Zeile, 2 B, 3 C, usw.
Next

R.Cells(Columns("H").Column) = CDbl(TextBox1) 'B6
R.Cells(Columns("L").Column) = CDbl(TextBox7) 'C21
R.Cells(Columns("J").Column) = CDbl(TextBox4) 'C17
R.Cells(Columns("K").Column) = CDbl(TextBox5) 'C18
R.Cells(Columns("I").Column) = CDbl(TextBox6) 'C19
R.Cells(Columns("N").Column) = ComboBox1 'C20

'Fromel einreichten
R.Cells(7).FormulaR1C1 = "=SUM(RC[1]+RC[4]-RC[2])" 'Formel in Spalte G: Gesamtverbrauch per Tag aus EVN & Einspeisung aus PV Anlage
R.Cells(8).FormulaR1C1 = "=(RC3-R[-1]C3)" 'Formel in Spalte H (relative Adressierung)
' =SUM(RC[1]+RC[4])
R.Cells(9).Interior.ColorIndex = 35 'Spalte I
' R.Cells(9).FormulaR1C1 = "=(RC[-1])/24"
' R.Cells(13).Formula = "=TEXT(" & R.Cells(1).Address & ",""TTTT"")" 'Formel in Spalte M

R.Cells(13).Formula = "=TEXT(RC[-12],""TTTT"")"

'Färbung
R.Interior.Pattern = xlNone
R.Cells(5).Interior.ColorIndex = 36
R.Cells(7).Interior.ColorIndex = 34
R.Cells(9).Interior.ColorIndex = 35

'Abschluss
Range("A2").Select
Application.ScreenUpdating = True
Unload Me '--- Userform schließen

Dim raFund As Range
With ActiveSheet
Set raFund = .Columns(3).Find(What:="*", LookIn:=xlValues, LookAt:=xlWhole, _
searchdirection:=xlPrevious)
If Not raFund Is Nothing Then
Application.Goto .Cells(raFund.Row - 3, 1), True
End If
End With
Set raFund = Nothing
Range("A2").Select
End Sub

Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

Forumthread: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

Forumthread: Suchen in Datei - Fehlerhafte Auflistung - obwohl richtig

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread