Probleme nach Suchen per VBA
Wolfgang
in einer etwas komplexeren Arbeitsmappe habe ich dank Eurer Mithilfe die Suchmöglichkeit von Datensätzen nach Datum (siehe auch untenstehende Codes) und die andere Suchmöglichkeit nach Worten/Silben über 2 getrennte Schaltflächen installiert.- Grundsätzlich funktioniert auch beides. Nur, wenn ein Suchlauf gestartet wurde, kann passieren, dass beim nächsten Lauf nichts mehr angezeigt wird (obschon noch etwas angezeigt werden müßte).- Erst wenn ich Excel vollständig abmelde, also nicht nur die Arbeitsmappe schließe, und nach Neustart von Excel dann den Suchlauf wieder starte, erhalte ich weitere Ergebnisse.- Was läuft da verkehrt? Untenstehende Codes falsch? - Andere Dinge meinerseits vielleicht nicht bedacht? - Merkwürdig finde ich eben, dass erst bei Neustart von Excel wieder neue Ergebnisse angezeigt werden.- Danke schon jetzt wieder für Eure Mithilfe.
Gruß - Wolfgang Berger
Hier nun der Code für Suche nach Datum (die Ergebnisse werden dabei in eine neue Mappe kopiert):
Option Explicit
Sub DialogAufruf()
frmSearch.Show
End Sub
'Suche nach Datum
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, 9)).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
'Hier der andere Suchlauf nach Silben etc.:
'Suche nach Begriffen, Silben etc.
Sub suchen()
Dim Tabelle As Worksheet
Dim GZelle As Range
Dim FStelle$
Dim SBegriff
Dim blatt
blatt = Application.ActiveSheet.Name
SBegriff = "" & InputBox("Bitte Suchbegriff eingeben:", "Suchen nach Begriffen/Silben:")
'**********Abbbruch*******
If SBegriff = "" Then
MsgBox "Eingabe wurde abgebrochen!"
ThisWorkbook.Sheets(blatt).Activate
Exit Sub
End If
If SBegriff = "" Then
MsgBox "Es wurde nichts eingeschrieben oder abgebrochen!"
Exit Sub
End If
For Each Tabelle In Worksheets
If Tabelle.Name > "Start" Then
Tabelle.Activate
Set GZelle = Tabelle.Cells.Find(SBegriff)
If Not GZelle Is Nothing Then
FStelle = GZelle.Address
Do
GZelle.Activate
If MsgBox("Weiter?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Set GZelle = Cells.FindNext(After:=ActiveCell)
If GZelle.Address = FStelle Then Exit Do
Loop
End If
End If
Next Tabelle
ThisWorkbook.Sheets(blatt).Activate
MsgBox "Nichts mehr gefunden - Ende !"
End Sub
Anzeige