VBA Daten finden mit find/findnext Methode
Axel
ich habe mal wieder ein kleines Problem mit VBA.
Ich habe ein Excelblatt mit mehreren Tabellen, die ich in kopieren will. Wobei dieses Blatt immer wieder neu erstellt wird und somit sich die Tabellen jedes Mal ändern.
Die Tabellen sind begrenzt, von oben nach unten durch "leere Zellen" und von Links nach Rechts durch den Begriff "TIME".
Ich hatte mir vorgestellt, dass ich praktisch die Eckpunkte in einen Array schreibe und dann anhand dieses die Daten kopiere. Leider funktioniert meine find/findnext Methode nicht so richtig.
Der erste Teil funktioniert sehr gut und ich bekomme die Spalten in denen die Tabellen anfangen. Aber der Zweite Teil (Zeilen) funktioniert leider nicht wie gewünscht.
Ich habe auch schon versucht beide Suchen in eine Funktion zu schreiben, aber das ist mir leider auch misslungen.
Sub Datenfinden()
Dim i As Integer
Dim gefundene_Zelle_TIME As Range, gefundene_Zelle_leer As Range, ErsteZelle As Range
Dim Spalte(3)
Dim Zeile(3)
i = 0
With Sheets(1).Range("A2:ZZ2")
Set gefundene_Zelle_TIME = .Find(What:="TIME", After:=.Cells(.Cells.Count), LookIn:=xlValues, _
SearchDirection:=xlNext, MatchCase:=False) 'Sucht den Begriff
If Not gefundene_Zelle_TIME Is Nothing Then
ErsteZelle = gefundene_Zelle_TIME.Address
Do
Spalte(i) = gefundene_Zelle_TIME.Column
Set gefundene_Zelle_TIME = .FindNext(gefundene_Zelle_TIME)
i = i + 1
Loop While Not gefundene_Zelle_TIME Is Nothing And gefundene_Zelle_TIME.Address _
ErsteZelle 'Prüf so lange, bis wieder die erste Zelle gefunden wurde
End If 'Prüft ob der Suchbegriff überhaupt existiert
End With
i = 0
Spaltenbuchstabe = Split(Cells(1, Spalte(i)).Address, "$")(1)
Set gefundene_Zelle_leer = Range(Spaltenbuchstabe & ":" & Spaltenbuchstabe).Find(What:="", _
LookIn:=xlValues, SearchDirection:=xlNext, MatchCase:=False) 'Sucht den Begriff
If Not gefundene_Zelle_leer Is Nothing Then
ErsteZelle = gefundene_Zelle_leer.Address
Do
Zeile(i) = gefundene_Zelle_leer.Row
i = i + 1
Spaltenbuchstabe = Split(Cells(1, Spalte(i)).Address, "$")(1)
Set gefundene_Zelle_leer = Range(Spaltenbuchstabe & ":" & Spaltenbuchstabe). _
FindNext("")
Loop While Not gefundene_Zelle_leer Is Nothing And gefundene_Zelle_leer.Address _
ErsteZelle 'Prüft so lange, bis wieder die erste Zelle gefunden wurde
End If 'Prüft ob der Suchbegriff überhaupt existiert
End Sub
Gruß und Dank
Axel
Anzeige