Zeilen ausblenden

Hallo Excel Freunde,
gestern hat mir Rudi Maintaire schon bei meinem Problem geholfen.
https://www.herber.de/forum/messages/1920060.html
Eigentlich dachte ich das jetzt alles perfekt funktioniert. Nun baue ich es gerade in meine scharfe Datei ein und stelle fest das von jeder Farbe immer nur eine Zeile sichtbar bleibt.
Ich kann variable Suchkriterien in einer Msgbox eingeben und in der kompletten Tabelle suchen lassen. Alle Treffer werden dann markiert.( Hintergrundfarbe farbig)
Ist zwar ein wenig langsam aber es funktioniert.
Da meine Tabelle sehr viele Daten hat möchte ich gern alle Zeilen ohne Treffer ausblenden. ( alle Zeilen ohne Hintergrundfarbe)
Kann sich dies nochmal jemand anschauen?
In der Beispieltabelle habe ich ein Arbeitsblatt und eine Tabelle mit dem Wunschergebnis erstellt. In diesem Beispiel habe ich nach rolf/Jens/tom gesucht.
https://www.herber.de/bbs/user/157818.xlsm.
Kann sich dies nochmal jemand anschauen?
Habt schon mal rechtvielen dank für euer unterstützung
mfg thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Farbpruefung() Dim Rng As Range Rows.Hidden = True For Each Rng In Range("A2:N" & Cells(Rows.Count, "B").End(xlUp).Row) If Rng.Interior.ColorIndex > xlNone Then Rng.EntireRow.Hidden = False End If Next ActiveWindow.LargeScroll Down:=-3 End Sub

Sub ausblenden2() Dim Rng As Range With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With Rows.Hidden = True For Each Rng In Range("A2:Nz" & Cells(Rows.Count, "B").End(xlUp).Row) If Rng.Interior.ColorIndex > xlNone Then Rng.EntireRow.Hidden = False End If Next ActiveWindow.LargeScroll Down:=-3 With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub

Hallo,
der Fundbereich (rngFind) muss auch innerhalb Do...Loop aktualisiert werden.

Sub farben()
  Dim strFind$, myFind, firstAdd$, i&
  Dim strTemp$
  Dim zeil$
  Dim wert() As String
  Dim rngFind As Range
  
  With Application
    .ScreenUpdating = False
    '.EnableEvents = False
    .Calculation = xlCalculationManual
  End With
  
  
  strFind$ = InputBox("Bitte geben Sie die Suchbegriffe ein." & vbNewLine _
    & "Trennen Sie die Suchbegriffe mit einem Schrägstrich / ", "Suche")
  
  If strFind$ = vbNullString Then Exit Sub
  Rows.Hidden = False
  Cells.Interior.Color = xlNone
  
  For i = LBound(Split(strFind$, "/")) To UBound(Split(strFind$, "/"))
    strTemp$ = Trim(Split(strFind$, "/")(i))
    'Set myFind = Cells.SpecialCells(xlCellTypeVisible).Find(strTemp$, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    Set myFind = Cells.Find(strTemp$, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    
    If Not myFind Is Nothing Then
      
      If rngFind Is Nothing Then
        Set rngFind = myFind
      Else
        Set rngFind = Union(rngFind, myFind)
      End If
      
      firstAdd$ = myFind.Address
      '----------------------
      
      Do
        Select Case i
          Case 0: myFind.Interior.Color = vbRed 'ich
          Case 1: myFind.Interior.Color = vbBlue 'ich
          Case 2: myFind.Interior.Color = vbGreen 'ich
          Case 3: myFind.Interior.Color = vbMagenta 'ich
          Case 4: myFind.Interior.Color = vbYellow 'ich
          Case 5: myFind.Interior.Color = vbCyan 'ich
        End Select
        
        If rngFind Is Nothing Then
          Set rngFind = myFind
        Else
          Set rngFind = Union(rngFind, myFind)
        End If
        
        'Set myFind = Cells.SpecialCells(xlCellTypeVisible).FindNext(myFind)
        Set myFind = Cells.FindNext(myFind)
        
      Loop While myFind.Address > firstAdd$
      
    End If
  Next i
  
  If Not rngFind Is Nothing Then
    Range(Rows(1), Rows(10000)).Hidden = True
    rngFind.EntireRow.Hidden = False
    Application.Goto Cells(1, 1), True
  End If
  
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen ausblenden

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread