Hilfe - weiß nicht m. weiter; Suche n. Datum VBA
15.03.2004 07:42:36
Wolfgang
hatte mich bereits schon i.d. vergang. Woche mit meinem Problem a.d. Forum gewandt:
Der Code aus der Mustermappe 131801 (siehe auch unten) bewirkt, dass eine Arbeitsmappe nach Vorgabe gesucht wird und die Ergebniszeilen in einer neuen Excel-Mappe angezeigt werden. Funktioniert auch soweit (nur mit der Null gibt es dabei Probleme).
Auf Hinweis von Ramses und Nepomuk habe ich versucht, den Code umzustellen, um nun ausschließlich die Datensätze nach Datum (welches ausschließlich in Spalte B -ab B3- steht) zu suchen. Nun sucht Excel auch das Datum, aber an einer beliebigen Stelle, weiterhin kopiert mir Excel allesmögliche 'rüber, nur nicht die jeweiligen Datensätze bzw. Zeilen ( z.B. B = Datum; D = Name, Vorname E = Summe etc.) - Was mache ich nur verkehrt? - Hat jemand eine Idee? - Gibt es vielleicht noch einen ganz anderen Ansatz, um Zeilen nach Datum zu suchen und das Ergebnis in einer neuen Mappe anzeigen zu lassen?
Danke schon jetzt für Eure Mithilfe - Gruß Wolfgang Berger
Hier der "Original-Code":
Sub MultiSuche(strSearch As Long)
Dim wks As Worksheet
Dim rngFind As Range
Dim lngRow As Long
Dim strFind As String
Workbooks.Add
For Each wks In ThisWorkbook.Worksheets
Set rngFind = wks.Cells.Find(strSearch)
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
lngRow = lngRow + 1
wks.Range(wks.Cells(rngFind.Row, 2), _
wks.Cells(rngFind.Row, 18)).Copy _
Cells(lngRow, 1)
Set rngFind = wks.Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
Next wks
End Sub
'Code für UF - Suchen
Private Sub cmdSearch_Click()
If txtSearch.Text = "" Then Exit Sub
Call MultiSuche(CLng(txtSearch.Text))
End Sub
Hier nun der umgestellte Code, mit dem die Zeilen, die sich hinter dem gesuchten Datum befinden, jeweils in eine neue Arbeitsmappe kopiert werden:
Private Sub cmdSearch_Click()
If txtSearch.Text = "" Then Exit Sub
Call MultiSuche(CDate(Me.Search.Text))
End Sub
Sub MultiSuche(strSearch As Date)
Dim wks As Worksheet
Dim rngFind As Range
Dim lngRow As Long
Dim strFind As String
Workbooks.Add
For Each wks In ThisWorkbook.Worksheets
Set rngFind = wks.Cells.Find(CDate(strSearch))
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
lngRow = lngRow + 1
wks.Range(wks.Cells(rngFind.Row, 2), _
wks.Cells(rngFind.Row, 18)).Copy _
Cells(lngRow, 1)
Set rngFind = wks.Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
Next wks
End Sub