mit nachfolgendem Code kann ich eine Exceltabelle durchsuchen und das Ergebnis in einer Listbox auflisten.
Wie kann ich die Suche auf alle Exceltabellen in einem Verzeichnis erweitern?
Danke für eure Hilfe.
andreas
' Suche nach Kontentext und anzeige in einer Listbox,
' nach Auswahl eines Kontos springen in die Tabellenzeile
Private Sub cmdsuchtext_Click()
Dim zeile As Integer
Dim spalte As Integer
Dim laenge As Integer
Dim suchtext As String
Dim letzte_zeile As Integer
Dim letzte_spalte As Integer
zeile = ActiveCell.Row
spalte = ActiveCell.Column
' Update des Fenster ausschalten
Application.ScreenUpdating = False
' Listbox leeren
frmsuchtext.lsterg.Clear
' Letzte Zeile ermitteln
letzte_spalte = ActiveSheet.UsedRange.Columns.Count
letzte_zeile = ActiveSheet.UsedRange.Rows.Count
Cells(2, 1).Activate
' Länge des zu suchenden Strings ermitteln
laenge = Len(txtsuchtext.Text)
If laenge = 0 Then
MsgBox "Sie müssen einen Suchtext eingeben!", vbOKOnly + vbInformation, "Fehler"
' Update des Fenster einschalten
Application.ScreenUpdating = True
Exit Sub
End If
Dim i As Integer
While ActiveCell.Row "" Then
'string_bilden
If InStr(1, UCase(such_string), UCase(txtsuchtext.Text)) > 0 Then
' Listbox füllen
suchtext = Cells(ActiveCell.Row, 2).Value & ", " & Cells(ActiveCell.Row, 3).Value
frmsuchtext.lsterg.AddItem suchtext
frmsuchtext.lsterg.List(lsterg.ListCount - 1, 1) = ActiveCell.Row
End If
End If
Cells(ActiveCell.Row + 1, 1).Activate
Wend
If lsterg.ListCount = 0 Then
MsgBox "Es gibt keine Texte zu der Eingabe:" & txtsuchtext.Text & "!", vbOKOnly + _
vbInformation, "Fehler"
lblerg.Caption = "Suchergebnis:"
Else
lblerg.Caption = "Es wurden " & lsterg.ListCount & " Textstellen gefunden"
End If
' Gehe an die Position vor der Suche
Cells(zeile, spalte).Activate
' Update des Fenster einschalten
Application.ScreenUpdating = True
' Text im eingabefeld markieren und Focus draufsetzen
If Len(txtsuchtext.Text) > 0 Then
txtsuchtext.SelStart = 0
txtsuchtext.SelLength = Len(txtsuchtext.Text)
End If
txtsuchtext.SetFocus
End Sub