Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Suchen über mehrere TB hinweg VBA
Moni
Hallo an alle,
ich wäre euch sehr dankbar, wenn ihr mir helfen könntet.
Ich habe eine Arbeitsmappe in der das erste Blatt eine Textbox und ein Button hat. Hier wird der Suchbegriff eingegeben.
Prozedur im Arbeitsblatt:

Private Sub TextBox1_Change()
Suchbegriff = TextBox1.Text
End Sub

Das zweite Arbeitsblatt heißt "Ergebnisse", hierhin sollen die Suchergebnisse kopiert werden.
Alle weiteren Arbeitsblätter beinhalten die zu durchsuchenden Daten.
Die Suche in einem Arbeitsblatt habe ich hinbekommen. Aber das mit der For... Next Schleife klappt nicht - bzw. glaube ich, dass die Ergebnisse jeweils mit den neuen überschrieben werden.
Ich glaube es hat etwas mit der Variable "LetzteZelle" zu tun und ich muss etwas mit Rows.count machen... Ich weiß allerdings nicht wie...
Prozedur im Modul:

Public Suchbegriff As String
Sub Schaltfläche2_KlickenSieAuf()
Dim Zelle As Variant, ErsteAdresse As String
Dim LetzteZelle As Integer, intCount As Integer
Dim i As Integer
Application.ScreenUpdating = False
Worksheets("Ergebnisse").Cells.Clear 'Alte Tabelleninhalte löschen
If Suchbegriff = "" Then Exit Sub
With Worksheets(3)
'Überschriftenzeile kopieren ...
.Rows(1).Copy Destination:=Worksheets("Ergebnisse").Range("a1")
End With
For i = 3 To Worksheets.Count
With Worksheets(i)
With .UsedRange
Set Zelle = .Find(What:=Suchbegriff, After:=Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlNext, MatchCase:=True)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
LetzteZelle = 2
Do
.Rows(Zelle.Row).Copy _
Destination:=Worksheets("Ergebnisse") _
.Cells(LetzteZelle, 1)
Set Zelle = .FindNext(Zelle)
LetzteZelle = LetzteZelle + 1
Loop While Not Zelle Is Nothing And _
Zelle.Address  ErsteAdresse
End If
End With
End With
Next
Worksheets("Ergebnisse").Select
Range("a1").Select
Application.ScreenUpdating = True
MsgBox ("Suchergebnis fuer: " & Suchbegriff)
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Suchen über mehrere TB hinweg VBA
02.12.2010 22:16:59
Gerd
Guten Abend Moni!
Du vermutest richtig.
Sub Schaltfläche2_KlickenSieAuf()
Dim Zelle As Range, ErsteAdresse As String
Dim i As Integer
Application.ScreenUpdating = False
Worksheets("Ergebnisse").Cells.Clear 'Alte Tabelleninhalte löschen
If Suchbegriff = "" Then Exit Sub
With Worksheets(3)
'Überschriftenzeile kopieren ...
.Rows(1).Copy Destination:=Worksheets("Ergebnisse").Range("a1")
End With
For i = 3 To Worksheets.Count
With Worksheets(i)
Set Zelle = .Cells.Find(What:=Suchbegriff, After:=.Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlNext, MatchCase:=True)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
Do
.Rows(Zelle.Row).Copy _
Destination:=Worksheets("Ergebnisse") _
.Cells(Worksheets("Ergebnisse").Rows.Count, 1).End(xlUp).Offset(1)
Set Zelle = .FindNext(Zelle)
If Zelle Is Nothing Then Exit Do
Loop While Zelle.Address  ErsteAdresse
End If
End With
Next
Application.Goto Worksheets("Ergebnisse").Range("a1")
Application.ScreenUpdating = True
MsgBox ("Suchergebnis fuer: " & Suchbegriff)
End Sub
Gruß Gerd
Anzeige
AW: Suchen über mehrere TB hinweg VBA
02.12.2010 22:54:43
Moni
Hi Gerd,
danke für deine Antwort!
Es funktioniert schon mal besser. Aber noch nicht ganz richtig...
Es bricht irgendwie zu früh ab.... und gibt nicht alle Zeilen wieder...
Ich hab meine Bsp.-Datei mal hochgeladen... vielleicht könntest du mal reinschauen?
https://www.herber.de/bbs/user/72564.xlsm
Danke!
AW: Suchen über mehrere TB hinweg VBA
02.12.2010 23:22:21
Gerd
Hi!
Du du keine klassischen Listen, durchgängig gefüllt in Zeile 1 u. Spalte A, hast,
ersetze:
Destination:=Worksheets("Ergebnisse") _
.Cells(Worksheets("Ergebnisse").Rows.Count, 1).End(xlUp).Offset(1)
durch:
Destination:=Worksheets("Ergebnisse") _
.Cells(Worksheets("Ergebnisse").UsedRange.Rows.Count, 1).Offset(1)
Gruß Gerd
Anzeige

328 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige