auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

Suchfunktion über mehrere Workbooks und Worksheets hinweg

Suchfunktion über mehrere Workbooks und Worksheets hinweg.
Range(adr).Show, Worksheets(i).Range("A:G").Find(myString, LookIn:=xlValues)
Const mk = "0000_Index.xls", a1 = "a1", f1 = "f1", pw = "********" Konstanten
Sub books_open1() Zunächst mal die gewünschten Workbooks öffnen
On Error GoTo end1
DName = Application.GetOpenFilename("Excel-Dateien (*.xls),*.xls", , , , True) Öffnet Dateien ohne Angabe des Pfades oder des
counter = 1 Dateinamens
Application.ScreenUpdating = False
If ActiveWorkbook.Name <> mk Then Aktives Workbook von der Suche ausschließen
While counter <= UBound(DName)
Workbooks.Open DName(counter), Password:=pw
counter = counter + 1
Wend
End If
Workbooks(mk).Activate
end1: Exit Sub
End Sub
Sub such_stop() Suchfunktion (stoppt auf jedem Worksheet)
Dim i%, b%, x%, myString$, c As Object, Treffer$, treff2$, adr$
i = 0: b = 0: x = 0
myString = Range(f1).Value
myString = InputBox("Bitte Suchbegriff eingeben" & vbCrLf & vbCrLf & "Beispiele:" & vbCrLf & _
" se*en findet sehen + setzen" & vbCrLf & " fun?tion findet funktion + function", , myString)
If myString = Empty Then Exit Sub
Range(f1).Value = myString
Range(f1).Value = "" Zelle leeren, da Wert in InputBox steht
Application.ScreenUpdating = False
For x = 1 To Workbooks.Count Workbooks zählen
With Workbooks(x)
For i = 1 To Sheets.Count Worksheets zählen
Set c = Worksheets(i).Range("a1:g1000").Find(myString, LookIn:=xlValues)
If Not c Is Nothing Then Objekt c ist der Inhalt der Zelle
adr = c.Address adr = ZellenAdresse
Do
Application.ScreenUpdating = False
ActiveWorkbook.Activate: Worksheets(i).Select
Application.ScreenUpdating = True
Range(adr).Show: Range(adr).Select
datname = ActiveWorkbook.Name Dateiname feststellen
do_it = MsgBox("Suchbegriff wurde gefunden!" & vbCrLf & "Weitersuchen?", vbYesNo, "Frage")
Set c = Worksheets(i).Range("a1:g1000").FindNext(c) Objekt c für den Suchvorgang
Application.ScreenUpdating = False
If do_it = vbYes Then
b = b + 1 Zählt Anzahl der gefundenen Strings
ElseIf do_it = vbNo Then
If datname <> mk Then
Workbooks(mk).Activate: Range(f1).Value = myString: Range(a1).Select
Workbooks(datname).Activate Zurückspringen ins letzte Workbook
Else
Range(f1).Value = myString
End If
Exit Sub
End If
Loop While c Is Nothing And c.Address <> adr Nur ein mal pro Blatt finden!
End If
Next i
End With
ActiveWindow.ActivateNext Nächstes Workbook aktivieren
Next x
Workbooks(mk).Activate: Range(f1).Value = myString: Range(a1).Select
If b = 0 Then MsgBox "Keinen Treffer " & myString & " gefunden"
End Sub
Sub Suchen() Suchfunktion (nur Zählen der gesuchten Begriffe)
Dim i%, b%, x%, myString$, c As Object, Treffer$, treff2$, adr$
i = 0: b = 0: x = 0
myString = Range(f1).Value
myString = InputBox("Bitte Suchbegriff eingeben" & vbCrLf & vbCrLf & "Beispiele:" & vbCrLf & _
" se*en findet sehen + setzen" & vbCrLf & " fun?tion findet funktion + function", , myString)
If myString = Empty Then Exit Sub
Range(f1).Value = myString
Range(f1).Value = "" Zelle leeren, da Wert in InputBox steht
Application.ScreenUpdating = False
For x = 1 To Workbooks.Count Workbooks zählen
With Workbooks(x)
For i = 1 To Sheets.Count Worksheets zählen
Set c = Worksheets(i).Range("a1:g1000").Find(myString, LookIn:=xlValues)
If Not c Is Nothing Then Objekt c ist der Inhalt der Zelle
adr = c.Address adr = ZellenAdresse
Do
b = b + 1 Zählt Anzahl der gefundenen Strings
Set c = Worksheets(i).Range("a1:g1000").FindNext(c) Objekt c für den Suchvorgang
Loop While Not c Is Nothing And c.Address <> adr Alle Treffer auf einem Blatt finden!
End If
Next i
End With
ActiveWindow.ActivateNext Nächstes Workbook aktivieren
Next x
Workbooks(mk).Activate
Range(f1).Value = myString
If b > 0 Then
treff2 = "Der Suchbegriff " & myString & " wurde " & b & " mal gefunden."
Treffer = MsgBox(treff2, vbOKOnly, "Info")
Else
MsgBox "Keinen Treffer " & myString & " gefunden"
End If
End Sub
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt