Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Kombinierte Suche in Excel mit mehreren Treffern

Frage Microsoft Microsoft Office

Mitglied: midnightautomatic

midnightautomatic (Level 1) - Jetzt verbinden

25.09.2010, aktualisiert 16:55 Uhr, 10738 Aufrufe, 24 Kommentare

Suchfunktion mit mehreren ODER-Konnektoren und einer Trefferliste

Hallo zusammen,
ist es möglich in Excel mittels VBA eine Suchfunktion mit einer beliebigen Anzahl von ODER-Konnektoren zu erstellen, so dass ich eine Liste mit den Zeilen/Zellen bekommen, die die Treffer beinhalten, so wie in Access?
Grüße
Alexander
Mitglied: bastla
25.09.2010 um 10:18 Uhr
Hallo nostrakis!

Um Deine Frage möglichst exakt zu beantworten:

Grundsätzlich: Ja.

Grüße
bastla
Bitte warten ..
Mitglied: midnightautomatic
25.09.2010 um 12:22 Uhr
Hi, da bin ich wieder. Ist das ein großer Act? Ich habe eine Liste mit Artikelnummer, Beschreibung, Preis etc. mit Büromaterial, ca. 5000 Artikel. Ich bin soweit, dass, wenn ich die Menge in eine Zeile eintrage, auf einem anderen Blatt in einem Bestellformular die Artikel mit den nötigen Daten automatisch übertragen werden. Den Code habe ich mir Stück für Stück im Netz zusammengesucht und den Rest mit dem Makro-Recorder aufgenommen und angepasst. Jetzt suche ich z.B. Haftnotizen. Die können aber auch Post-Its, etc. heißen.
Der Teil, der jetzt ansteht ist schwieriger oder? Irgendein Vorschlag, oder ist das sehr kompliziert?

Grüße
Alexander
Bitte warten ..
Mitglied: 76109
25.09.2010 um 13:57 Uhr
Hallo Alexander!

Hier mal ein Beispiel, wie so etwas funktionieren könnte, wobei die Suchtreffer in einer MsgBox ausgegeben werden.

Konstanten entsprechend anpassen:
01.
Const SheetName = "Tabelle1"        ' Tabellennamen 
02.
Const Suchbereich = "A:C"           ' Suchbereich in den Spalten A-C oder in der Art "A:A" 
03.
 
04.
Sub Test() 
05.
    Dim Suchliste As Variant, Token As Variant, Eingabe As String, Ergebnisliste As String 
06.
     
07.
    Eingabe = InputBox("Bitte Suchbegriffe Komma-Getrennt eingeben:", "Suchen...") 
08.
     
09.
    If Eingabe = "" Then Exit Sub 
10.
     
11.
    Suchliste = Split(Eingabe, ",") 
12.
     
13.
    For Each Token In Suchliste 
14.
        If Token <> "" Then 
15.
            Call Search(Sheets(SheetName).Range(Suchbereich), Trim(Token), Ergebnisliste) 
16.
        End If 
17.
    Next 
18.
     
19.
    If Ergebnisliste = "" Then 
20.
        MsgBox "Keine Übereinstimmung gefunden!", vbInformation, "Suchergebnis..." 
21.
    Else 
22.
        MsgBox Ergebnisliste, , "Suchergebnis..." 
23.
    End If 
24.
End Sub 
25.
 
26.
Private Sub Search(ByRef Area, ByRef Token, ByRef List) 
27.
    Dim Found As Range, FirstAddress As String 
28.
     
29.
    Set Found = Area.Find(Token, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
30.
     
31.
    If Not Found Is Nothing Then 
32.
        FirstAddress = Found.Address 
33.
        Do 
34.
            List = List & Token & vbTab & Found.Address & vbCr 
35.
            Set Found = Area.FindNext(Found) 
36.
        Loop While Not Found Is Nothing And Found.Address <> FirstAddress 
37.
    End If 
38.
End Sub
Für Teil-Übereinstimmungen den Parameter xlPart anstatt xlWhole verwenden

Gruß Dieter

[edit] @bastla etwas zu langsam [/edit]
Bitte warten ..
Mitglied: bastla
25.09.2010 um 14:06 Uhr
Hallo nostrakis!

Schematisch könnte das so aussehen:
01.
Sub Suchen() 
02.
Suche = "Haftnotiz Post-It Klebezettel" 
03.
 
04.
QuellTabelle = "Daten" 
05.
QuellZeile = 2 
06.
SuchSpalte = 2 'B 
07.
QuellSpalteVon = 1 'A 
08.
QuellSpalteBis = 4 'D 
09.
 
10.
ZielTabelle = "Ergebnis" 
11.
ZielZeile = 2 
12.
ZielSpalte = "A" 
13.
 
14.
With Worksheets(QuellTabelle) 
15.
    Wert = .Cells(QuellZeile, SuchSpalte).Value 
16.
    Do While Wert <> "" 
17.
        If InStr(1, Suche, Wert, vbTextCompare) > 0 Then 
18.
            Worksheets(ZielTabelle).Cells(ZielZeile, ZielSpalte).Resize(1, QuellSpalteBis - QuellSpalteVon + 1).Value = .Range(.Cells(QuellZeile, QuellSpalteVon), .Cells(QuellZeile, QuellSpalteBis)).Value 
19.
            ZielZeile = ZielZeile + 1 
20.
        End If 
21.
        QuellZeile = QuellZeile + 1 
22.
        Wert = .Cells(QuellZeile, SuchSpalte).Value 
23.
    Loop 
24.
End With 
25.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: midnightautomatic
25.09.2010 um 16:44 Uhr
Vielen Dank für die Antworten. Allerdings kriege ich es nicht zum Laufen, weil ich trotz der Anpassungen Kompilierungsfehler bekomme. Nur einmal grundsätzlich bitte:
Das sind doch Makros, oder? Ich speicher das als Modul. Für die Variablen brauche ich dann noch extra Code, oder? Sind das Kurzfassungen, die Ihr mir gepostet habt, oder läuft das im Grunde 1:1?
Sorry wegen des Einsteiger-Niveaus, aber ich weiß es wirklich nicht besser.
Gruß
Alexander
Bitte warten ..
Mitglied: bastla
25.09.2010 um 18:14 Uhr
Hallo nostrakis!
weil ich trotz der Anpassungen Kompilierungsfehler bekomme
... die der Geheimhaltung unterliegen?
Ich speicher das als Modul.
Eigentlich in einem Modul - also "Einfügen" - "Modul" - in das Modul Dieters und / oder meinen Code kopieren
Für die Variablen brauche ich dann noch extra Code, oder?
Falls Du damit meinst, dass die Suchbegriffe, die ich in die Variable "Suche" (Zeile 2) geschrieben habe, eingegeben werden sollen, dann ja (wie das gehen könnte, siehst Du in Dieters Beispiel) - ansonsten ist mir die Frage nicht klar ...
Sind das Kurzfassungen, die Ihr mir gepostet habt, oder läuft das im Grunde 1:1?
Wenn Du ein Tabellenblatt "Tabelle1" mit Daten in den Spalten A bis C hast, kannst Du Dieters Variante unmittelbar verwenden; für meinen Vorschlag sollten die Tabellen "Daten" und "Ergebnis" existieren (bzw die Tabellennamen in den Zeilen 4 und 10 angepasst werden), wobei in der Spalte B im Blatt "Daten" gesucht wird und die Werte aus den Spalten A bis D der gefundenen Zeilen nach "Ergebnis" übertragen werden.

Grüße
bastla
Bitte warten ..
Mitglied: 76109
25.09.2010 um 18:33 Uhr
Hallo Alexander!

Wenn der Kompilierungsfehler bei bastlas Code auftritt, dann lösche, falls vorhanden, am Blattanfang die Zeile mit "Option Explicit"

Gruß Dieter
Bitte warten ..
Mitglied: midnightautomatic
25.09.2010 um 18:48 Uhr
Hi Ihr beiden!
Fragt mich bitte nicht warum, auf einmal geht's!
Besten Dank und viele Grüße
Alexander
Bitte warten ..
Mitglied: midnightautomatic
25.09.2010 um 19:55 Uhr
Hi Bastla!

Mich würde noch interessieren, wie das in Deinem File mit dem Pendant zu Dieters xlPart aussieht. Wenn in der zu findenden Zelle statt "Haftnotiz", beispielsweise "Haftnotiz 50 x 75mm gelb 100 Blatt" steht, bekomme ich nämlich keine Treffer.

Grüße
Alexander
Bitte warten ..
Mitglied: bastla
25.09.2010 um 21:40 Uhr
Hallo nostrakis!

Um auch Teiilstrings zu finden, müsste jeder einzelne Wert mit allen Suchbegriffen getrennt verglichen werden:
01.
Sub Suchen() 
02.
Suche = "Haftnotiz,Post-It,Klebezettel" 
03.
Delim = "," 'Trennzeichen zwischen Suchbegriffen 
04.
 
05.
QuellTabelle = "Daten" 
06.
QuellZeile = 2 
07.
SuchSpalte = "B" 
08.
QuellSpalteVon = "A" 
09.
QuellSpalteBis = "D" 
10.
 
11.
ZielTabelle = "Ergebnis" 
12.
ZielZeile = 2 
13.
ZielSpalte = "A" 
14.
 
15.
Such = Split(Suche, Delim) 'Suchbegriffe in Array aufteilen 
16.
SuchAnz = UBound(Such) 'höchsten Index des Such-Arrays vor der Schleife (und damit nur einmal) ermitteln 
17.
 
18.
With Worksheets(QuellTabelle) 
19.
    Wert = .Cells(QuellZeile, SuchSpalte).Value 
20.
    Do While Wert <> "" 
21.
        For i = 0 To SuchAnz 
22.
            If InStr(1, Wert, Such(i), vbTextCompare) > 0 Then 
23.
                Worksheets(ZielTabelle).Cells(ZielZeile, ZielSpalte).Resize(1, 4).Value = .Range(.Cells(QuellZeile, QuellSpalteVon), .Cells(QuellZeile, QuellSpalteBis)).Value 
24.
                ZielZeile = ZielZeile + 1 
25.
                Exit For 'Suchbegriff enthalten, weitere Vergleiche für diesen Wert unnötig 
26.
            End If 
27.
        Next 
28.
        QuellZeile = QuellZeile + 1 
29.
        Wert = .Cells(QuellZeile, SuchSpalte).Value 
30.
    Loop 
31.
End With 
32.
End Sub
Das Trennzeichen (siehe Zeile 3) zwischen den Suchbegriffen habe ich lt Dieters Beispiel mit Komma vorgegeben, es kann jedoch auch jedes andere nicht in den Suchbegriffen vorkommende Zeichen gewählt werden. Anders als bei Dieters Version (Stichwort: "LookAt:=xlWhole") muss bei der Suche nach Teilstrings kein "*" (vor und oder nach dem Suchbegriff) verwendet werden.

Grüße
bastla

P.S.: Im Zweifelsfall würde ich für das Suchen, nicht zuletzt aus Performancegründen, zu Dieters Ansatz raten ...
Bitte warten ..
Mitglied: midnightautomatic
25.09.2010 um 23:05 Uhr
Hi Bastla!
Vielen Dank! Jetzt bin ich einen großen Schritt weiter!
Gruß
Alexander
Bitte warten ..
Mitglied: 76109
26.09.2010 um 11:04 Uhr
Hallo Alexander, Hallo bastla!

Was spricht eigentlich gegen eine Filterfunktion per ComboBox-Auswahl.

Der AutoFilter läßt nur 2 Kriterien mit Operator (Und/Oder...) zu. Von daher bietet sich eine ComboBox für die Auswahl der Suchbegriffe an, die den AutoFilter je nach Auswahl steuert.

Dazu müsste lediglich im Tabellenblatt eine Combo-Box (ComboBox1) erstellt werden. Den Rest übernimmt der VBA-Code.

Diesen Quellcode zum Initialisieren der ComboBox in "DieseArbeitsmappe" einfügen (Konstanten anpassen):
01.
Const FilterSheet = "Tabelle1" 
02.
Const FilterAuswahl = "Haftnotiz, Post-It, Klebezettel" 
03.
 
04.
Private Sub Workbook_Open() 
05.
    Dim Kriterien As Variant, Token As Variant 
06.
     
07.
    Kriterien = Split("Filter Aus," & FilterAuswahl, ",") 
08.
     
09.
    With Sheets(FilterSheet).ComboBox1 
10.
       .Clear 
11.
        For Each Token In Kriterien 
12.
            If Not Token = "" Then .AddItem Trim(Token) 
13.
        Next 
14.
       .ListIndex = 0 
15.
    End With 
16.
End Sub
Und diesen Quellcode in das entsprechende Tabellenblatt (Daten) einfügen (Konstante anpassen):
01.
Const FilterRange = "B:B"   'Spalte mit Filterbegriffen 
02.
 
03.
Private Sub ComboBox1_Change() 
04.
    Dim Suchtext As String 
05.
     
06.
    If ComboBox1.Text = "Filter Aus" Then 
07.
        ActiveSheet.AutoFilterMode = False 
08.
    Else 
09.
        Suchtext = "*" & ComboBox1.Text & "*"  'Teilübereinstimmung vor und nach mit "*" 
10.
        Range(FilterRange).AutoFilter Field:=1, Criteria1:=Suchtext, VisibleDropDown:=False 
11.
    End If 
12.
End Sub
wobei mit dem Parameter "VisibleDropDown:=False" kein Filter-Steuerelement angezeigt wird.

Der erste Eintrag in der ComboBox wird mit dem Item "Filter Aus" automatisch generiert und die Suchbegriffe in der Konstanten "FilterAuswahl" hinzugefügt.

Einzelne Schritte:
1. Die beiden Quellcodes in ihren Zielort kopieren
2. Eine ComboBox mit dem Namen ComboBox1 erstellen. Bei anderem Namen die Quellcodes entsprechend anpassen.
3. Einmalig Ausführen: Cursor in "DieseArbeitsmappe" auf die Prozedur "Workbook_Open" setzen und die Taste F5 drücken.

Probiers mal aus

Gruß Dieter
Bitte warten ..
Mitglied: midnightautomatic
26.09.2010 um 19:30 Uhr
Hi Dieter, hi Bastla!

Ich habe einen Mix aus Euren Versionen gemacht und bin eigentlich ganz zufrieden:

01.
Sub Suchen() 
02.
    Sheets("Vergleich").Select 
03.
    Columns("A:F").Select 
04.
    Selection.ClearContents 
05.
Suche = InputBox("Bitte Suchbegriffe Komma-Getrennt eingeben:", "Suchen...") 
06.
'If Eingabe = "" Then Exit Sub 
07.
Delim = "," 'Trennzeichen zwischen Suchbegriffen 
08.
 
09.
QuellTabelle = "Daten" 
10.
QuellZeile = 2 
11.
SuchSpalte = "C" 
12.
QuellSpalteVon = "A" 
13.
QuellSpalteBis = "F" 
14.
 
15.
ZielTabelle = "Vergleich" 
16.
ZielZeile = 2 
17.
ZielSpalte = "A" 
18.
 
19.
Such = Split(Suche, Delim) 'Suchbegriffe in Array aufteilen 
20.
SuchAnz = UBound(Such) 'höchsten Index des Such-Arrays vor der Schleife (und damit nur einmal) ermitteln 
21.
 
22.
With Worksheets(QuellTabelle) 
23.
    Wert = .Cells(QuellZeile, SuchSpalte).Value 
24.
    Do While Wert <> "" 
25.
        For i = 0 To SuchAnz 
26.
            If InStr(1, Wert, Such(i), vbTextCompare) > 0 Then 
27.
                Worksheets(ZielTabelle).Cells(ZielZeile, ZielSpalte).Resize(1, 6).Value = .Range(.Cells(QuellZeile, QuellSpalteVon), .Cells(QuellZeile, QuellSpalteBis)).Value 
28.
                ZielZeile = ZielZeile + 1 
29.
                Exit For 'Suchbegriff enthalten, weitere Vergleiche für diesen Wert unnötig 
30.
            End If 
31.
        Next 
32.
        QuellZeile = QuellZeile + 1 
33.
        Wert = .Cells(QuellZeile, SuchSpalte).Value 
34.
    Loop 
35.
End With 
36.
 
37.
Range("F2").Select 
38.
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-2]*RC[-1])" 
39.
    Range("F2").Select 
40.
    Selection.AutoFill Destination:=Range("F2:F201"), Type:=xlFillDefault 
41.
    Range("D2").Select 
42.
     
43.
End Sub
Probleme habe ich allerdings bei der Integration in meinen Workflow. Vermutlich hätte ich die bei der Version mit der Combobox nicht. Würde ich gerne einmal ausprobieren. Hab's aber nicht hingekriegt. Wärest Du so lieb, Dieter, und schickst mir das Beispiel mit der Box an diese E-Mail-Adresse: [gelöscht]

Da wäre ich Dir sehr dankbar.

Grüße

Alexander
Bitte warten ..
Mitglied: midnightautomatic
27.09.2010 um 18:12 Uhr
Hi Dieter,

vielen Dank für das Beispiel mit der ComboBox. Ist zwar nicht ganz das, was ich gesucht habe, weil ich eine Ergebnisliste mit allen Suchkriterien brauche, aber an anderer Stelle ist die ComboBox sicher prima einsetzbar. Besonders gut gefällt mir, dass man mit Wildcards arbeiten kann.

Beste Grüße

Alexander
Bitte warten ..
Mitglied: 76109
27.09.2010 um 20:24 Uhr
Hallo Alexander!

OK, war nur so ne Idee

Gruß Dieter
Bitte warten ..
Mitglied: midnightautomatic
28.09.2010 um 18:32 Uhr
Hi Dieter, hi Bastla!
zunächst noch einmal vielen Dank für die Hilfe. Leider ist die Performance der von mir oben genannten kombinierten Lösung dermaßen schlecht in Excel 2003, dass man sie da nicht mehr verwenden kann.
Dieter, wäre es sehr kompliziert, anstatt der Ausgabe in der MsgBox die Ergebnisspalten zeilenweise auf einem Tabellenblatt auszugeben? Das wäre perfekt.
Grüße
Alexander
Bitte warten ..
Mitglied: 76109
28.09.2010 um 19:30 Uhr
Zitat von midnightautomatic:
Hi Dieter, hi Bastla!
zunächst noch einmal vielen Dank für die Hilfe. Leider ist die Performance der von mir oben genannten kombinierten
Lösung dermaßen schlecht in Excel 2003, dass man sie da nicht mehr verwenden kann.
Und Genau aus diesem Grund hatte bastla ja meine Lösung vorgeschlagen. weil integrierte Excel-Funktionen, wie beispielseise Find/Next codemäßig wesentlich schneller laufen, als Makrocode

Dieter, wäre es sehr kompliziert, anstatt der Ausgabe in der MsgBox die Ergebnisspalten zeilenweise auf einem Tabellenblatt
auszugeben? Das wäre perfekt.
Nö ist es nicht, ich hatte zu diesem Zeitpunkt nur noch nicht soweit gedacht wie bastla, der schon einen Schritt weiter war
Meine Konzentration läßt gerade etwas nach und bin von daher im Moment etwas schwer von Begriff Was soll jetzt genau in eine Tabelle geschrieben werden?
Nur die Inhalte aus einer Spalte (vermutlich D) oder ganze Zeilen oder nur die Zell-Adressen oder was?

Gruß Dieter
Bitte warten ..
Mitglied: bastla
28.09.2010 um 21:47 Uhr
@Dieter
Und Genau aus diesem Grund hatte bastla ja meine Lösung vorgeschlagen

ich hatte zu diesem Zeitpunkt nur noch nicht soweit gedacht wie bastla, der schon einen Schritt weiter war
I wo - ich weiß einfach, dass Du den besseren VBA-Code schreibst ...

Grüße
bastla
Bitte warten ..
Mitglied: midnightautomatic
28.09.2010 um 21:51 Uhr
Hi Dieter!
Die ganzen Zeilen natürlich. Das wäre Klasse!
Grüße
Alexander
Bitte warten ..
Mitglied: 76109
29.09.2010 um 10:15 Uhr
Hallo bastla!

Zitat von bastla:
I wo - ich weiß einfach, dass Du den besseren VBA-Code schreibst ...
Booaaah, da kann man mal sehen, wieviel ich von Dir gelernt habe

Spaß beiseite! Ich sehe das nicht so, denn Du schaffst es immer wieder, mich mit Deinen faszinierenden Codeschnippsels zu verblüffen

Gruß Dieter
Bitte warten ..
Mitglied: 76109
29.09.2010 um 10:16 Uhr
Hallo Alexander!

Teste mal beide Versionen. Ich vermute mal das Version 2 schneller als Version 1 ist?

Version 1:
01.
Const SheetQuelle = "Daten"         ' Tabelle Daten/Suchen 
02.
Const SheetZiel = "Vergleich"       ' Tabelle Suchergebnis 
03.
 
04.
Const SpalteSuchen = "C:C"          ' Spalte Suchen 
05.
Const DatenSpalteVon = "A"          ' Daten kopieren von Spalte 
06.
Const DatenSpalteBis = "F"          ' Daten kopieren bis Spalte 
07.
 
08.
Const ZielSpalte = "A"              ' Spalte Ziel-Tabelle 
09.
 
10.
Sub Suchen() 
11.
    Dim WksQ As Worksheet, WksZ As Worksheet, Suchliste As Variant, Token As Variant, Eingabe As String 
12.
     
13.
    Eingabe = InputBox("Bitte Suchbegriffe Komma-Getrennt eingeben:", "Suchliste...") 
14.
     
15.
    If Eingabe = "" Then Exit Sub 
16.
     
17.
    Set WksQ = Sheets(SheetQuelle) 
18.
    Set WksZ = Sheets(SheetZiel):  WksZ.Cells.Clear 
19.
     
20.
   'Überschriftzeile in Ziel-Tabelle schreiben 
21.
    Range(WksQ.Cells(1, DatenSpalteVon), WksQ.Cells(1, DatenSpalteBis)).Copy WksZ.Cells(1, ZielSpalte) 
22.
     
23.
    Suchliste = Split(Eingabe, ",") 
24.
     
25.
    For Each Token In Suchliste 
26.
        If Token <> "" Then Call SearchAndCopy(WksQ, Trim(Token), WksZ) 
27.
    Next 
28.
End Sub 
29.
 
30.
Private Sub SearchAndCopy(ByRef WksQ, ByRef Token, WksZ) 
31.
    Dim Found As Range, FirstAddress As String, Zeile As Long 
32.
     
33.
    With WksQ 
34.
        Set Found = .Range(SpalteSuchen).Find(Token, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 
35.
         
36.
        If Not Found Is Nothing Then 
37.
            FirstAddress = Found.Address 
38.
            Do 
39.
                Zeile = WksZ.Cells(WksZ.Rows.Count, "C").End(xlUp).Row + 1 
40.
                Range(.Cells(Found.Row, DatenSpalteVon), .Cells(Found.Row, DatenSpalteBis)).Copy _ 
41.
                   WksZ.Cells(Zeile, ZielSpalte) 
42.
                Set Found = .Range(SpalteSuchen).FindNext(Found) 
43.
            Loop While Not Found Is Nothing And Found.Address <> FirstAddress 
44.
        End If 
45.
    End With 
46.
End Sub
Version2:
01.
Const SheetQuelle = "Daten"         ' Tabelle Daten/Suchen 
02.
Const SheetZiel = "Vergleich"       ' Tabelle Suchergebnis 
03.
 
04.
Const SpalteSuchen = "C:C"          ' Spalte Suchen 
05.
Const DatenSpalteVon = "A"          ' Daten kopieren von Spalte 
06.
Const DatenSpalteBis = "F"          ' Daten kopieren bis Spalte 
07.
 
08.
Const ZielSpalte = "A"              ' Spalte Ziel-Tabelle 
09.
 
10.
Sub Suchen() 
11.
    Dim WksQ As Worksheet, WksZ As Worksheet, Suchliste As Variant, Token As Variant, Eingabe As String 
12.
     
13.
    Eingabe = InputBox("Bitte Suchbegriffe Komma-Getrennt eingeben:", "Suchliste...") 
14.
     
15.
    If Eingabe = "" Then Exit Sub 
16.
     
17.
    Set WksQ = Sheets(SheetQuelle) 
18.
    Set WksZ = Sheets(SheetZiel):  WksZ.Cells.Clear 
19.
     
20.
   'Überschriftzeile in Ziel-Tabelle schreiben 
21.
    Range(WksQ.Cells(1, DatenSpalteVon), WksQ.Cells(1, DatenSpalteBis)).Copy WksZ.Cells(1, ZielSpalte) 
22.
     
23.
    Suchliste = Split(Eingabe, ",") 
24.
     
25.
    For Each Token In Suchliste 
26.
        If Token <> "" Then Call SearchAndCopy(WksQ, Trim(Token), WksZ) 
27.
    Next 
28.
End Sub 
29.
 
30.
Private Sub SearchAndCopy(ByRef WksQ, ByRef Token, WksZ) 
31.
    Dim Found As Range, Suchtext As String, ZeileQ As Long, ZeileZ As Long 
32.
     
33.
    With WksQ 
34.
        Suchtext = "*" & Token & "*"  'Teilübereinstimmung vor und nach mit "*" 
35.
        If .Range(SpalteSuchen).AutoFilter(Field:=1, Criteria1:=Suchtext, VisibleDropDown:=False) Then 
36.
            ZeileQ = WksQ.Cells(WksQ.Rows.Count, "C").End(xlUp).Row 
37.
            ZeileZ = WksZ.Cells(WksZ.Rows.Count, "C").End(xlUp).Row + 1 
38.
            Range(.Cells(2, DatenSpalteVon), .Cells(ZeileQ, DatenSpalteBis)).Copy WksZ.Cells(ZeileZ, ZielSpalte) 
39.
        End If 
40.
       .AutoFilterMode = False 
41.
    End With 
42.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: midnightautomatic
29.09.2010 um 17:11 Uhr
Hallo Dieter!

Scheint mir auch so. Werde ich morgen gleich 'mal in Excel 2003 testen.

Prima und vielen Dank!

Grüße

Alexander
Bitte warten ..
Mitglied: 76109
29.09.2010 um 20:02 Uhr
Hallo Alexander!

Habs mal getestet

Bei ca 32.000 Zeilen mit 3 Suchbegriffen und 10.000 Treffer-Zeilen dauerts bei mir: Mit Version1 ca 5 Sekunden und mit Version2 weniger als 1 Sekunde. Das sollte an Performance gerade noch akzeptabel sein

Gruß Dieter
Bitte warten ..
Mitglied: t3jxbus
13.10.2016 um 11:06 Uhr
Hallo,

etwas viel später, aber vlt könnt ihr mir ja helfen. Erstmal Supercode da unten mit der Suche, er funktioniert soweit gut. Allerdings bräuchte ich noch eine Erweiterung. In meiner Tabelle sind mehrere Projekte, der Beginn jedes Projektes ist frablich unterlegt. Jedes Projekt hat gleiche Termin, nur mit unterschiedlichem Datum. Mit der Suche spuckt er mir zwar die Termine aus, aber nicht die Zugehörigkeit zum richtigen Projekt. Kann ich da irgendwas machen, damit das möglich ist? Bin da mit meinem Latein etwas am Ende, und hab keine Idee.
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...