mr.green
Goto Top

Mehrere Spalten Durchsuchen und Ergebnisse in neuer Tabelle Ausgeben

Hallo liebe Community.

Ich würde gerne mit einer VBA mehrere Spalten ("A:W") in einer Tabelle nach einem oder mehreren Kriterium bzw Kriterien mittels InputBox durchsuchen. Alle Ergebnisse sollen dann auf einem zweiten Tabellenblatt ausgegeben werden. Hierzu habe ich auch bereits ein entsprechendes Makro gefunden, welches allerdings nur in einer Spalte (derzeit A) sucht.
Meine Versuche den Code entsprechen anzupassen sind leider fehlgeschlagen.


Hier der Code:

Const SheetQuelle = "Daten"           ' Tabelle Daten/Suchen  
Const SheetZiel = "Vergleich"                      ' Tabelle Suchergebnis  

Const SpalteSuchen = "A:A"                         ' Nutzer:ID  

Const DatenSpalteVon = "A"                        ' Daten kopieren von Spalte  
Const DatenSpalteBis = "V"                         ' Daten kopieren bis Spalte  

Const ZielSpalte = "A"                                   ' Spalte Ziel-Tabelle  
Const ZielZeile = "5"                                     ' ab Zeile Ziel-Tabelle  



Sub Suchen()
    Dim WksQ As Worksheet, WksZ As Worksheet, Suchliste As Variant, Token As Variant, Eingabe As String, SpalteSuchen As Worksheet
    
    Eingabe = InputBox("Bitte Suchbegriffe Komma-Getrennt eingeben:", "Suche")  
    
        If Eingabe = "" Then Exit Sub  
    
        Set WksQ = Sheets(SheetQuelle)
        Set WksZ = Sheets(SheetZiel):  WksZ.Cells.Clear
        
    
        'Überschriftzeile in Ziel-Tabelle schreiben  
        Range(WksQ.Cells(1, DatenSpalteVon), WksQ.Cells(1, DatenSpalteBis)).Copy WksZ.Cells(ZielZeile, ZielSpalte)
    
        Suchliste = Split(Eingabe, ",")  
        
    For Each Token In Suchliste
        If Token <> "" Then Call SearchAndCopy(WksQ, Trim(Token), WksZ)  

    Next
    
        
End Sub


Private Sub SearchAndCopy(ByRef WksQ, ByRef Token, WksZ)
    Dim Found As Range, Suchtext As String, ZeileQ As Long, ZeileZ As Long
    
    With WksQ
        Suchtext = "*" & Token & "*"  'Teilübereinstimmung vor und nach mit "*"  
        If .Range(SpalteSuchen).AutoFilter(Field:=1, Criteria1:=Suchtext, VisibleDropDown:=False) Then
            ZeileQ = WksQ.Cells(WksQ.Rows.Count, "A").End(xlUp).Row  
            ZeileZ = WksZ.Cells(WksZ.Rows.Count, "A").End(xlUp).Row + 1  
            Range(.Cells(2, DatenSpalteVon), .Cells(ZeileQ, DatenSpalteBis)).Copy WksZ.Cells(ZeileZ, ZielSpalte)
        End If
       .AutoFilterMode = False
    End With
End Sub

Versuche ich die Konstante SpalteSuchen zb mit "A:A, B:B" zu definieren bekomme ich einen Laufzeitfehler (1004); "Dies kann nicht mit einer Mehrfachauswahl ausgeführt werden."
Versuche ich SpaltenSuchen zb mit "A:W2000" anzupassen sucht er nur in Spalte A.

Hat jemand einen Tip für mich?

Content-Key: 318030

Url: https://administrator.de/contentid/318030

Ausgedruckt am: 19.03.2024 um 05:03 Uhr

Mitglied: 131026
131026 16.10.2016 aktualisiert um 09:47:45 Uhr
Goto Top
Versuche ich die Konstante SpalteSuchen zb mit "A:A, B:B" zu definieren bekomme ich einen Laufzeitfehler (1004); "Dies kann nicht mit einer Mehrfachauswahl ausgeführt werden."
Logisch wenn du dir folgende Zeile 44 mal ansiehst ... Klingelt da was bei Field:=1 im Oberstübchen ?! Genau, egal was du am Range änderst er sucht immer nur in der ersten Spalte durch diesen Parameter.
Nutze statt dem AutoFilter einfach Range.Find mit einer Schleife um deinen erweiterten Bereich zu durchsuchen.

Excel 2013 Suche nach einem Wert in mehreren Excel-Dateien und Ausgabe weiterer Werte zum Suchergebnis incl. Angabe der Quelldatei mittel Makro

Mithilfe eines Makros mehrere Excel-Datein nach einem Begriff durchsuchen und Daten kopieren

VBScript, Excel - Find in Range

Gruß R.
Mitglied: Mr.Green
Mr.Green 16.10.2016 um 16:40:45 Uhr
Goto Top
Vielen Dank für deine Antwort! Das Problem habe ich zwar noch nicht lösen können, aber vielleicht wird das ja noch in den kommenden Stunden =)

Schönen rest Sonntag wünsche ich!
Mitglied: 131026
131026 16.10.2016 aktualisiert um 18:18:12 Uhr
Goto Top
aber vielleicht wird das ja noch in den kommenden Stunden =)
Nur so lernt man programmieren vernünftig, durch hartnäckig bleiben und Handbuch lesen. Da musst du durch... bist aber am Ende schlauer als vorher face-wink
Nur copy n' paste bringt dich zu nichts.