Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Excel vba Blockweise Formatierung
#1
Hallo zusammen,

darf ich Euch mal wieder um Eure werte Hilfe bitten?

In einer immer weiterwachsenden Datentabelle trage ich einer Spalte ("N") einen Status des entsprechenden Datensatzes ein, z.B. neu, offen, OK.
Datensätze aus der gleichen Kategorie stehen immer untereinander und sind in einem Block zusammengefasst. Der Block beginnt jeweils mit einer Überschrift und endet mit einer Leerzeile.
Nach der Leerzeile beginnt dann der nächste Block usw....... Die Überschriftenzeile ist farblich hervorgehoben, die Leerzeile dagegen nicht.

Da die Tabelle hunderte von Zeilen und Datensätze haben kann, will ich der Übersichtlichkeit halber, alle Datensätze die komplett den Status "OK" haben ausblenden können.....und zwar komplett mit seiner Überschrift und der Leerzeile nach dem Datenblock. Befindet sich innerhalb eines Datensatzes noch ein Element, das den Status "neu" oder "offen" hat, soll der Datensatz nicht ausgeblendet werden. Bisher habe ich das quasi manuell gelöst indem ich über ein Makro den Datenblock in der entsprechenden Zelle mit "Headder" und "Space" gekennzeichnet habe.
Anhand dieser "Marker" habe ich dann die entsprechenden Zeilen ausgeblendet siehe Makro 2.

Nun meine Frage, wie könnte ich speziell die Beschriftung komplett automatisieren, nur wenn alle Datensätze in einem Block den Status "OK" haben?
Am Beginn eines Datenblockes mit seiner blauen Zeile soll "Headder" und am Ende in die leere Zelle soll "Space" eingetragen werden.

Das sieht dann so aus wie in der beigefügten Datei ersichtlich.

Code:
'Spalte 14 "N" beschriften
Private Sub CommandButton4_Click()
  xCol = ActiveCell.Column
  xRow = ActiveCell.Row
 
  If ActiveCell.Column <> 14 Then
      Cells(xRow, 14).Select
  End If
 
  'Wenn Zelle "Blau"
  If ActiveCell.Interior.ColorIndex = 23 Then
      ActiveCell.Value = "Headder"
      xRow = ActiveCell.Row + 1
      Cells(xRow, 14).Select
      'Wenn Zelle ohne Farbe
  ElseIf ActiveCell.Interior.ColorIndex = -4142 Then
      ActiveCell.Value = "Space"
      'Cells(xRow, 14).Select
      xRow = ActiveCell.Row + 1
      Cells(xRow, 14).Select
  Else
      xRow = ActiveCell.Row
      xRow = ActiveCell.Row + 1
      Cells(xRow, 14).Select
      Exit Sub
  End If
End Sub

Makro 2:
Code:
'Alle Zeilen mit bestimmtem Zellinhalt ausblenden
Sub Spezielle_Zeilen_ausblenden()
  Application.ScreenUpdating = False
 
  'Hier wir die letzte Zeile der Spalte A ermittelt
  letzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  'MsgBox letzteZeile
 
  For i = 6 To letzteZeile
      If Cells(i, 14).Value = "OK" Or Cells(i, 14).Value = "Headder" Or Cells(i, 14).Value = "Space" Then
        Rows(i).Hidden = True
      End If
  Next i
  Application.ScreenUpdating = False
End Sub


Angehängte Dateien
.xlsm   TestV1..xlsm (Größe: 51,91 KB / Downloads: 7)
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#2
Hallo,

leider entspricht deine Liste nicht den Vorgaben vo Excel, sonst wäre das ganz einfach mit dem Autofilter zu lösen. Zwischenüberschriften und Leerzeilen gehören da nicht rein.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
[-] Folgende(r) 1 Benutzer sagt Danke an Klaus-Dieter für diesen Beitrag:
  • sharky51
Antwortento top
#3
Klaus-Dieter,

nun ja, das ist mir schon bewusst.

Leider komme ich um die Zwischenüberschriften nicht herum.
Das Ausblenden nur der der OK-Datenblöcke würde reichen.
Auf die Leerzeilen könnte ich natürlich auch verzichten.... sind nur bei allen eingeblendeten Zeilen für die Übersichtlichkeit schön zu haben.
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#4
Hallo Sharky,

wenn Du konsequent mit den Farben arbeitest und nur die Blöcke (von Überschrift bis Leerzeile) ein bzw. ausblenden möchtest, kannst Du gerne mal u.a. Code testen.
Da brauchst Du auch Deine Headder- und Space-Angaben nicht.

PS: Leider hattest Du zwei Hintergrundblaus verwendet, sollte nicht sein, aber das kann das Tool ja auch trotzdem. 
Den Option Compare Text bitte als erstes im Modul platzieren.
Code:
Option Compare Text

Sub Spezielle_Zeilen_ausblenden_Neu()
 Dim iZeile As Long, WSh As Worksheet
 Dim sBer As String, bCheck As Boolean
 
 Application.ScreenUpdating = False
  
 Set WSh = ActiveSheet
 
 For iZeile = 6 To WSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With WSh.Cells(iZeile, "N")
      Select Case .Interior.Color
      Case 13395456, 12611584                                      'blau Headerzeile
        sBer = .Address: bCheck = True
      Case 16777215                                                'weiß Leerzeile
        WSh.Range(sBer & ":" & .Address).EntireRow.Hidden = bCheck 'Bereich ausblenden
      Case 5287936                                                 'grün Abschluss
        Exit For
      Case Else
        If Not .Value Like "OK" Then bCheck = False                'Zustand merken
      End Select
    
    End With
 
 Next iZeile
    
 WSh.Range("N2").Value = "Anzahl offener Befunde: "
 WSh.Range("I2:O2").Interior.ColorIndex = 6
 WSh.Range("I2:O2").Font.ColorIndex = 3
 WSh.Range("A1").Select
 
 Application.ScreenUpdating = True

End Sub
____________________
viele Grüße aus Freigericht
Karl-Heinz
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • sharky51
Antwortento top
#5
Hallo Karl-Heinz,

extrem cool, vielen Dank und so kurz und knackig!!!!!

Eine Frage hätte ich aber noch.

Wie können die "alle" grünen Zeilen ausgeblendet werden und nicht nur komplett abgeschlossene Blöcke?
In Deinem Beispiel werden die Zeilen mit Test 5,6 & 9 nicht ausgeblendet, sollten aber.

Hast Du da noch einen Lösungsansatz und wie komme ich auf Case-Definitionen der Zellfarben?
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#6
Hallo Sharky,

wenn alle grünen OK-Zeilen ebenfalls immer ausgeblendet werden sollen, braucht es nur eine kleine Modifikation.
Allerdings musste ich jetzt auch das Ein-Schalten wieder rausnehmen, so dass jetzt nur noch ausgeblendet wird.

PS: Die grünen OK-Zeilen werden jetzt auch über die Farbe ausgeblendet, egal ob da ok steht oder nicht.
Auch das kann man ändern aber bei konsequenter Anwendung dürfte in jeder grünen Zeile ja nur ok stehen...

Die Zellfarben habe ich einmalig mit u.a. Makro im Direktbereich ausgeben lassen....

Code:
Option Compare Text

Sub Spezielle_Zeilen_ausblenden_Neu()
 Dim iZeile As Long, WSh As Worksheet
 Dim sBer As String, bCheck As Boolean
 
 Application.ScreenUpdating = False
  
 Set WSh = ActiveSheet
 
 For iZeile = 6 To WSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With WSh.Cells(iZeile, "N")
      Select Case .Interior.Color
      Case 13395456, 12611584                                      'blau Headerzeile
        sBer = .Address: bCheck = True
      Case 16777215                                                'weiß Leerzeile
        If bCheck = True Then
          WSh.Range(sBer & ":" & .Address).EntireRow.Hidden = True 'Bereich ausblenden
        End If
      Case 52377                                                   'grün = ok
        WSh.Rows(iZeile).Hidden = True
      Case 5287936                                                 'grün Abschluss
        Exit For
      Case Else
        If Not .Value Like "OK" Then bCheck = False                'Zustand merken
      End Select
    
    End With
 
 Next iZeile
    
 WSh.Range("N2").Value = "Anzahl offener Befunde: "
 WSh.Range("I2:O2").Interior.ColorIndex = 6
 WSh.Range("I2:O2").Font.ColorIndex = 3
 WSh.Range("A1").Select
 
 Application.ScreenUpdating = True

End Sub


Sub ErmittleZellfarbe()
 Debug.Print ActiveCell.Interior.Color
End Sub
____________________
viele Grüße aus Freigericht
Karl-Heinz
[-] Folgende(r) 1 Benutzer sagt Danke an volti für diesen Beitrag:
  • sharky51
Antwortento top
#7
Hallo Karl-Heinz,

nochmals vielen Dank, jetzt passt alles und ich kann mir jetzt auch die OK-Einträge usw. in der Spalte "N" ersparen.

Mit diesem Makro blende ich wenn notwendig alles wieder ein:

Code:
'Alle ausgeblendeten Zeilen wieder einblenden
Sub AllesEinblenden()
  With ActiveSheet
      .Columns.Hidden = False            'Kurzform
      .Rows.EntireRow.Hidden = False 'Langform
  End With
 
  Range("N2").Value = "Anzahl aktueller und abgeschlossener Befunde: "
  Range("N2").Select
 
  Range("I2:O2").Interior.ColorIndex = 3
  Range("I2:O2").Font.ColorIndex = 6
  ActiveCell.Characters(Start:=21, Length:=16).Font.ColorIndex = 4
 
End Sub

Den Farbcode im Direkbereich anzuzeigen ist ne gute Idee.
Ich habe mich immer an Farbtabellen orientiert.


Ich wünsche Dir noch ein schönes WE!
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#8
Vielen Dank Erich für die positive Rückmeldung und auch ich wünsche ein schönes Wochenende aus dem nicht so sonnigen Hessen.

Karl-Heinz
Antwortento top
#9
Wenn du die leere Zellen in Spalte N keine Validation gibt, reicht dieser Code:

Code:
Sub M_snb()
    For Each it In Columns(14).SpecialCells(-4174).Areas
        it.EntireRow.Hidden = Application.CountIf(it, "OK") = it.Cells.Count - 1
    Next
End Sub
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antwortento top
#10
Hallo,

Auswertungen nach Zellformaten sind fast noch schlimmer als Zwischenüberschriften.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste