AW: Datensuche und Ausgabe
19.07.2005 19:11:02
Jens
schuldigung habe ich woll vergessen
Sub FindAll()
GlobaleSuche.Show
End Sub
Sub FindGlobal(Suchbegriff As String)
Dim firstCell, nextCell, StringToFind, Antwort As String
Dim mCase, notFound As Boolean
Dim Lookat, Lookin, sOrder As Variant
Dim FindFlag As Integer
Dim ws As Object
GlobaleSuche.Hide
If GlobaleSuche.chkGossKlein Then
mCase = True
Else
mCase = False
End If
If GlobaleSuche.chkGanzeZellen Then
Lookat = xlWhole
Else
Lookat = xlPart
End If
Select Case GlobaleSuche.ComboBox1.Value
Case "Wert"
Lookin = xlValues
Case "Formeln"
Lookin = xlFormulas
Case "Kommentare"
Lookin = xlNotes
End Select
Select Case GlobaleSuche.ComboBox2.Value
Case "In Zeilen"
sOrder = xlByRows
Case "In Spalten"
sOrder = xlByColumns
End Select
notFound = True
For Each ws In Worksheets
StringToFind = Suchbegriff
Set firstCell = Worksheets(ws.Name).Cells.Find(What:=StringToFind, _
Lookin:=Lookin, Lookat:=Lookat, SearchDirection:=xlPrevious, MatchCase:=mCase)
If Not firstCell Is Nothing Then
notFound = False
nextCell = Worksheets(ws.Name).Cells.FindNext _
(After:=Range(firstCell.Address)).Address
If ShowResult(ws.Name, nextCell) Then Exit Sub
Do While firstCell.Address <> nextCell
nextCell = Worksheets(ws.Name).Cells.FindNext _
(After:=Range(nextCell)).Address
If ShowResult(ws.Name, nextCell) Then Exit Sub
Loop
End If
Next ws
If notFound Then MsgBox ("Nicht gefunden"), vbExclamation
GlobaleSuche.Show
End Sub
Function ShowResult(Sheetname, CurCell)
Dim Antwort As String
Worksheets(Sheetname).Activate
Worksheets(Sheetname).Cells.Range(CurCell).Select
Antwort = MsgBox("Wert gefunden in: " & Sheetname & " " & CurCell, vbRetryCancel, "Weitersuchen")
If Antwort = vbCancel Then
ShowResult = True
GlobaleSuche.cmdSuchen.Caption = "Neue Suche"
GlobaleSuche.Show
End If
End Function