Daten filtern und kennzeichnen

Question

Ein herzliches Hallo an die Runde!

Ich habe verschiedene Arbeitsmappen mit bis zu 400 Tabellenblättern!

Auf einem Tabellenblatt namens "Inhalt" habe ich zu jedem Tabellenblatt verschiedene Suchkriterien (wa, bin, multi,...)eingegeben:

Diese Aufgabensammlung enthält z. B. 180 Aufgaben. Nun möchte ich erreichen, dass nach der Eingabe von Filterkriterien (z. B. wa, ber, multi) jene Aufgaben markiert werden (z.B. Einfärbung der Zellen A oder was auch immer), die alle Filterkriterien erfüllen.

In diesem Beispiel wären es die Aufgaben 1 und 5.

Im nächsten Schritt (das mache ich dann manuell)  blende ich alle Aufgaben (in diesem Fall die Zeilen im Tabellenblatt "Inhalt" aus), welche die Filterkriterien nicht erfüllen.

Ich hoffe, ich denke nicht zu kompliziert und vielleicht gibt es wesentlich einfachere Lösungsansätze (z. B. Eingabe der Suchkriterien direkt im Tabellenblatt, das dann automatisch ausgeblendet wird,...).

Um jede Idee wäre ich dankbar, nachdem ich schon einiges nach meinen Internetrecherchen ausprobiert habe.

MfG Robert

Answer 1

Hallo Robert,

das mit der farblichen Markierung der Spalte A kannst du mit der bedingten Formatierung machen.

Dazu musst du allerdings die Suchkriterien in das Tabellenblatt eintragen, z.B. in die Zellen H2 bis K2.

Gehe mit den Cursor in Zelle A5 und wähle im Menüband "Start" -> bedingte Formatierung -> Neue Regel -> Formel zur Ermittlung der zu formatierenden Zellen verwenden und füge dann die folgende Formel ein:

=ANZAHL2($H$2:$K$2)=WENN($H$2<>"";ZÄHLENWENN(H5:K5;$H$2);0)+WENN($I$2<>"";ZÄHLENWENN(H5:K5;$I$2);0)+WENN($J$2<>"";ZÄHLENWENN(H5:K5;$J$2);0)+WENN($K$2<>"";ZÄHLENWENN(H5:K5;$K$2);0)

Wähle dann die Formatierung aus, z.B. Zelle grün einfärben, wenn Bedingung erfüllt ist, und bestätige alles mit OK. Mit dem Formatpinsel kannst du die bedingte Formatierung dann von der Zelle A5 auf alle anderen benötigten Zellen übertragen.

Ein automatisches Ausblenden der Zeilen ist nur über VBA möglich. Du könntest auch mit dem in Excel vorhandenen FIlter arbeiten, aber dann müssten die jeweiligen Bedingungen (z.B. ber) immer in der selben Spalte stehen.

Gruß

M.O.

Answer 2

Hallo m.o.!

Recht herzlichen Dank für deinen Beitrag.

Ich komme erst übermorgen wieder an meinen Rechner, um die Formel auszuprobieren.

Aber so wie ich deine bisherigen Beiträge kenne, werde ich gut damit arbeiten können.

Mit freundlichen Grüßen Robert

Answer 3

Hallo m.o.

Die Formel funktioniert genauso, wie ich es mir vorgestellt habe.

Leider habe ich die Anfrage über mein Handy gestellt und erst jetzt bemerkt, dass ich diese eigentlich im falschen Forum gepostet habe.

Das Tüpfelchen auf dem I wäre jetzt, wenn man per vba - wie du angedeutet hast - alle nicht markierten Zeilen ausblenden (und in weiterer Folge dann wieder einblenden) könnte (wie schon erwähnt, besteht diese Mappe aus 175 Aufgaben und 175 dazugehörigen Lösungsblättern).

So könnte man in kurzer Zeit Arbeitsmappen für die SchülerInnen entsprechend den Filterkriterien bereitstellen.

Ich bedanke mich im Voraus für Anregungen und Ideen, die mir  weiterhelfen.

Schönen Abend!

Answer 4

Hallo Robert,

kopiere die beiden folgenden Makro in ein Standard-Modul deiner Arbeitsmappe:

Sub aufgaben()
Dim arrSuch As Variant
Dim a As Long
Dim lngAnzahl As Long
Dim lngLetzte As Long
Dim lngSpalte As Long
Dim lngZeile As Long

'letzte Zeile in Spalte B ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'Anzahl der Suchbegriffe ermitteln
For lngSpalte = 12 To 15
  If Cells(2, lngSpalte) <> "" Then lngAnzahl = lngAnzahl + 1
Next lngSpalte

'Array für Suchbegriffe redimensionieren; -1 da Array bei 0 anfängt
ReDim arrSuch(lngAnzahl - 1)

'Variable für lngAnzahl zurücksetzen
lngAnzahl = 0

'Suchbegriffe in Array einlesen
For lngSpalte = 12 To 15
  If Cells(2, lngSpalte) <> "" Then
    arrSuch(lngAnzahl) = Cells(2, lngSpalte).Value
    lngAnzahl = lngAnzahl + 1
   End If
Next lngSpalte

'Zeilen (ab Zeile 5) mit Aufgaben durchlaufen und Suchbegriffe überprüfen
For lngZeile = 5 To lngLetzte
 'Prüfen, ob in Spalte Aufg_ steht
 If Left(Cells(lngZeile, 2), 5) = "Aufg_" Then
   'lngAnzahl wieder zurücksetzen
   lngAnzahl = 0
   'Suchbegriffe überprüfen
   For lngSpalte = 12 To 15
     For a = LBound(arrSuch) To UBound(arrSuch)
       If Cells(lngZeile, lngSpalte) = arrSuch(a) Then lngAnzahl = lngAnzahl + 1
     Next a
    Next lngSpalte
    'Zeile ausblenden, wenn nicht alle Suchbegriffe gefunden wurden
    If lngAnzahl < UBound(arrSuch) Then Rows(lngZeile).EntireRow.Hidden = True
  End If
Next lngZeile

End Sub

Sub alles_einblenden()
ActiveSheet.UsedRange.Rows.Hidden = False
End Sub

Gruß

M.O.

Answer 5

Ein herzliches Dankeschön an m. o.

Nun passt alles perfekt und die Generierung von Übungsblättern kann dadurch sehr rasch erfolgen.

Ob meine SchülerInnen damit auch so begeistert sind, diese Frage beantworte ich mal optimistischerweise mit ja!

MfG Robert

Answer 6

Ein herzliches Hallo an die Runde!

Ich habe mein Arbeitsblatt abgeändert und das Makro entsprechend angepasst.
Aber irgendwie scheint es nicht ganz zu funken! Normalerweise müssten alle abgebildeten Aufgaben ausgeblendet werden, da für keine dieser Beispiele alle drei Bedingungen gelten.

Sub aufgaben()
Dim arrSuch As Variant
Dim a As Long
Dim lngAnzahl As Long
Dim lngLetzte As Long
Dim lngSpalte As Long
Dim lngZeile As Long
'letzte Zeile in Spalte B ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
'Anzahl der Suchbegriffe ermitteln
For lngSpalte = 15 To 18
  If Cells(4, lngSpalte) <> "" Then lngAnzahl = lngAnzahl + 1
Next lngSpalte
'Array für Suchbegriffe redimensionieren; -1 da Array bei 0 anfängt
ReDim arrSuch(lngAnzahl - 1)
'Variable für lngAnzahl zurücksetzen
lngAnzahl = 0
'Suchbegriffe in Array einlesen
For lngSpalte = 15 To 18
  If Cells(4, lngSpalte) <> "" Then
    arrSuch(lngAnzahl) = Cells(4, lngSpalte).Value
    lngAnzahl = lngAnzahl + 1
   End If
Next lngSpalte
'Zeilen (ab Zeile 5) mit Aufgaben durchlaufen und Suchbegriffe überprüfen
For lngZeile = 5 To lngLetzte
 'Prüfen, ob in Spalte Aufg_ steht
 If Left(Cells(lngZeile, 4), 5) = "Aufg_" Then
   'lngAnzahl wieder zurücksetzen
   lngAnzahl = 0
   'Suchbegriffe überprüfen
   For lngSpalte = 15 To 18
     For a = LBound(arrSuch) To UBound(arrSuch)
       If Cells(lngZeile, lngSpalte) = arrSuch(a) Then lngAnzahl = lngAnzahl + 1
     Next a
    Next lngSpalte
    'Zeile ausblenden, wenn nicht alle Suchbegriffe gefunden wurden
    If lngAnzahl < UBound(arrSuch) Then Rows(lngZeile).EntireRow.Hidden = True
  End If
Next lngZeile
End Sub

Nun bekomme ich zu viele Treffer, der Filter kombiniert die Suchbegriffe leider nicht mehr miteinander, damit erhalte ich zu viele Treffer! Ich habe die Formel wie gesagt anzupassen versucht, aber irgendwie scheine ich "betriebsblind" zu sein.

Ich hoffe, dass jemand im Forum den Fehler finden kann.

LG Robert

Answer 7

Hallo Robert,

bei mir funktioniert dein geändertes Makro. Hast du eventuell nocht etwas anderes geändert, z.B. auf dem Wort Aufg_ noch ein Leerzeichen eingefügt oder ähnliches?

Gruß

M.O.

Answer 8

Hall m.o.

Danke für die rasche Rückmeldung! Ich konnte den Fehler bisher leider nicht ausfindig machen.
Aber: Gut Ding braucht Weil (sprich noch ein paar Versuche am Abend)!

LG Robert

Answer 9

Schönen Abend an alle Anwesenden!

Nachdem ich trotz zahlreicher Versuche meinen Eingabefehler nicht finden konnte, poste ich mal ein Beispieldokument.

Ich bin schon etwas "betriebsblind" und hoffe darauf, dass jemand im Forum den Fehler findet.

Merci tausendmal.

LG Robert

https://supportnet.de/forum/?qa=blob&qa_blobid=18283972116129025295

Answer 10

Hallo Robert,

ich habe den Fehler gefunden, war ein Denkfehler in meinem ursprünglichen Makro.

Bei der Ermittlung, ob die Anzahl der Treffer mit den Anzahl der Suchkriterien übereinstimmt, war ein Fehler.

UBound(arrSuch) ergibt z.B. bei 2 Suchbegriffen 1, da der erste Suchbegriff bei 0 und der zweite bei 1 steht. Daher muss die Zeile richtig heißen:

If lngAnzahl < UBound(arrSuch) + 1 Then Rows(lngZeile).EntireRow.Hidden = True

Der Fehler ist mir beim Testen nicht aufgefallen, da ich nur wenige Datensätze hatte und wohl immer mit mehr als zwei Suchbegriffen getestet hatte.

Hier das verbesserte Makro:

Sub aufgaben()
Dim arrSuch As Variant
Dim a As Long
Dim lngAnzahl As Long
Dim lngLetzte As Long
Dim lngSpalte As Long
Dim lngZeile As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'letzte Zeile in Spalte B ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

'Anzahl der Suchbegriffe ermitteln
For lngSpalte = 15 To 18
  If Cells(4, lngSpalte) <> "" Then lngAnzahl = lngAnzahl + 1
Next lngSpalte

'Array für Suchbegriffe redimensionieren; -1 da Array bei 0 anfängt
ReDim arrSuch(lngAnzahl - 1)

'Variable für lngAnzahl zurücksetzen
lngAnzahl = 0

'Suchbegriffe in Array einlesen
For lngSpalte = 15 To 18
  If Cells(4, lngSpalte) <> "" Then
    arrSuch(lngAnzahl) = Cells(4, lngSpalte).Value
    lngAnzahl = lngAnzahl + 1
   End If
Next lngSpalte

'Zeilen (ab Zeile 5) mit Aufgaben durchlaufen und Suchbegriffe überprüfen
For lngZeile = 5 To lngLetzte
 'Prüfen, ob in Spalte Aufg_ steht
 If Left(Cells(lngZeile, 4), 5) = "Aufg_" Then
   'lngAnzahl wieder zurücksetzen
   lngAnzahl = 0
   'Suchbegriffe überprüfen
   For lngSpalte = 15 To 18
     For a = LBound(arrSuch) To UBound(arrSuch)
       If Cells(lngZeile, lngSpalte) = arrSuch(a) Then lngAnzahl = lngAnzahl + 1
     Next a
    Next lngSpalte
    'Zeile ausblenden, wenn nicht alle Suchbegriffe gefunden wurden
    If lngAnzahl < UBound(arrSuch) + 1 Then Rows(lngZeile).EntireRow.Hidden = True
  End If
Next lngZeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Da du ja viele Datensätze zu prüfen hast, habe ich noch die Bildschirmaktualisierung bei der Ausführung des Makros ausgeschaltet.

Gruß

M.O.