Kann ich einen Filter verwenden, der mehrere Spalten zusammenfasst?

[juvee]

Hi,

ich kann die Datei von OEE nicht öffnen, kann daher seine Lösung nicht nachvollziehen, habe aber auch einen Code für dich.

Du brauchst eine 2. Tabelle für die Ausgabe der extrahierten Daten

Code:

Option Explicit

Private Function sucheInZeilen(ByVal DataBase As Variant, vRet As Variant, vSuch As Variant) As Boolean

   Dim col As New Collection
  
   Dim i As Long, z As Long
   Dim j As Integer, k As Integer
   Dim varItem As Variant
   Dim blnF As Boolean
   
  
   For i = 1 To UBound(DataBase, 1)
        blnF = False
        For k = 2 To UBound(DataBase, 2)
         If LCase(DataBase(i, k)) Like "*" & LCase(vSuch) & "*" Then
            blnF = True
            Exit For
         End If
        Next
       
     
      If blnF Then col.Add i, CStr(i) ' Falls Suchkriterium erfüllt diese Zeilennummer merken
   Next
   
   If col.Count Then
      ReDim vRet(1 To col.Count, 1 To UBound(DataBase, 2))
      For i = 1 To col.Count
         For j = 1 To UBound(DataBase, 2)
            vRet(i, j) = DataBase(col(i), j)
         Next
      Next
      sucheInZeilen = col.Count
   End If
   Set col = Nothing
End Function


Sub main()
Dim vDataBase As Variant, vResult As Variant
Dim vSuchbegriff As Variant, vTitle As Variant
Dim i As Long, k As Long

vSuchbegriff = InputBox("bitte Suchbegriff eingeben", "Filter nach Genre")
If StrPtr(vSuchbegriff) = 0 Then Exit Sub

'Daten einlesen
With Worksheets("Tabelle1").Cells(1, 1).CurrentRegion         ' Tabellennamen ggfs anpassen
vTitle = .Resize(1).Value
vDataBase = .Offset(1).Resize(.Rows.Count - 1).Value
End With

If sucheInZeilen(vDataBase, vResult, vSuchbegriff) Then
  With Worksheets("Tabelle2")                                 ' Ausgabetabelle Name ggfs anpassen
    .UsedRange.ClearContents
    .Cells(1, 1).Resize(, UBound(vTitle, 2)) = vTitle
    .Cells(2, 1).Resize(UBound(vResult, 1), UBound(vTitle, 2)) = vResult
  End With
End If

End Sub

VG Juvee

[oee]

" ich kann die Datei von OEE nicht öffnen " ?
Warum nicht? Was passiert denn dann?

[Stephan L]

@juvee:
Hat geklappt und funktioniert! - Dank Dir für Deine tolle Arbeit!
Freu mich sehr drüber!!!

[oee]

Und wozu habe ICH mir die Arbeit gemacht, wenn du sie dir nicht mal anschaust ???

[snb]

Excel enthält Advanced Filter.

Code:

Sub M_snb()
  Sheet1.Cells(1, 21).Resize(, 18) = Sheet1.Cells(1, 2).Resize(, 18).Value
  Sheet2.UsedRange.ClearContents

  c00 = InputBox("bitte Suchbegriff eingeben", "Filter nach Genre")
  For j = 1 To 18
    Sheet1.Cells(j + 1, 20 + j) = c00
  Next

  Sheet1.Cells(1).CurrentRegion.AdvancedFilter 2, Sheet1.Cells(1, 21).CurrentRegion, Sheet2.Cells(1)
End Sub

[EA1950]

Hallo,

für dein Excel2021 gäbe es auch eine reine Formellösung ohne VBA:

Dein Datenbereich befindet sich ja in A1:S1500, wobei in Spalte A (A2:A1500) der Games-Bereich und in den Spalten B:S (B2:S1500) der Genre-Bereich ist.

1) Wenn du zB. in T1 dein Genre-Filterkriterium eingibst,
2) im Bereich T2:T1500 eine Hilfsspalte anfügst: in Zelle T2 mit folgender Formel =ODER($B2:$S2=$T$1) und diese hinunterkopierst bis Zelle T1500
3) dann kannst du mit folgender Formel dein Genre-Filterkriterium aus T1 auswerten: =FILTER($A$2:$A$1500; $T$2:$T$1500)

[juvee]

@ snb

coole Lösung, das nenn ich mal ne pfiffige Idee.

Nur noch den Kriterienbereich anschließend löschen.

[snb]

Es kann noch viel 'pfiffiger'

Code:

Sub M_snb()
  Sheet2.UsedRange.ClearContents
  Sheet1.Cells(1, 21) = InputBox("bitte Suchbegriff eingeben", "Filter nach Genre")
  Sheet1.Cells(1).CurrentRegion.AdvancedFilter 2, Sheet1.Cells(1, 22).Resize(2), Sheet2.Cells(1)
End Sub

[Stephan L]

@ EA1950 :
Klappt super, danke Dir! - Hab etwas gebraucht bis ich die Funktion verstanden habe!
Klasse, danke Dir!

[snb]

Noch einfacher: wähle das erwünschte Stichwort in Zelle U1 und schau mal was passiert ist in Sheet2