VBA Excel - finden Sie eine Zelle und formatieren Sie die Zellen unter

Question

Ich versuche Code zu erstellen, um Zellen in bestimmten Zeilen zu finden, die 0 enthalten, die dann die 8 Zellen direkt unterhalb formatiert, um einen weißen Hintergrund und eine weiße Schrift zu haben. Grundsätzlich machen die Zellen nicht sichtbar. Im Idealfall möchte ich die 8 Zellen wieder auf ihre ursprüngliche Formatierung ändern können, wenn die gesuchte Zelle ein X hat. Irgendwelche Hilfe? -Danke

Sample Data

Leider auf den Link Ich bin ein neuer Benutzer und bin nicht in der Lage das Beispiel Bild anzuzeigen, so klicken Sie bitte.

Answer 1

Sie haben unsere Fragen nicht beantwortet, also ist das Folgende vielleicht nicht ganz das, was Sie wollen ... aber es sollte ein guter Anfang sein.

Sub Hide8CellsBelow0() 

    Dim arrayRowNumbers() As Variant 
    arrayRowNumbers = Array(2, 12) ' <-- "Specific Rows" 

    Dim intRow As Integer 
    Dim objCell As Range 

    For intRow = 0 To UBound(arrayRowNumbers) 

     For Each objCell In ThisWorkbook.ActiveSheet.Rows(arrayRowNumbers(intRow)).Cells 

      Debug.Print objCell.Address & " : " & objCell.Value 

      If objCell.Text = "" Then Exit For ' <-- Quit the row after finding an empty cell 
      If objCell.Value = 0 Then 

       With Range(objCell.Offset(1), objCell.Offset(8)) 
        'I got the following from recording a Macro, you don't have to remember everything 
        With .Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorDark1 
        .TintAndShade = 0 
        .PatternTintAndShade = 0 
        End With 
        With .Font 
        .ThemeColor = xlThemeColorDark1 
        .TintAndShade = 0 
        End With 
       End With 

      End If 

     Next objCell 

    Next intRow 

End Sub 

Answer 2

Danke Steve! Ich entschuldige mich dafür, dass ich in den letzten Stunden nicht reagiert habe. Ich war mit meiner Familie auf einer Earth Day Cleanup.

Ich änderte es leicht, um die "spezifischen Zeilen" zu sehen, die 8, 18 und 28 waren und es funktioniert wie erwartet. Ich habe dann ein zweites Makro zum vorherigen die Schriftart zu ändern zurück, wenn ein X in den Reihen vorhanden waren, anstelle ein 0.

Sub Hide8CellsBelow0() 

Dim arrayRowNumbers() As Variant 
arrayRowNumbers = Array(8, 18, 28) ' <-- "Specific Rows" 

Dim intRow As Integer 
Dim objCell As Range 

For intRow = 0 To UBound(arrayRowNumbers) 

    For Each objCell In ThisWorkbook.ActiveSheet.Rows(arrayRowNumbers(intRow)).Cells 

     Debug.Print objCell.Address & " : " & objCell.Value 

     If objCell.Text = "" Then Exit For ' <-- Quit the row after finding an empty cell 
     If objCell.Value = 0 Then 

      With Range(objCell.Offset(1), objCell.Offset(8)) 
       'I got the following from recording a Macro, you don't have to remember everything 
       With .Interior 
       .Pattern = xlSolid 
       .PatternColorIndex = xlAutomatic 
       .ThemeColor = xlThemeColorDark1 
       .TintAndShade = 0 
       .PatternTintAndShade = 0 
       End With 
       With .Font 
       .ThemeColor = xlThemeColorDark1 
       .TintAndShade = 0 
       End With 
      End With 

     End If 

    Next objCell 

Next intRow 

End Sub 

Sub Show8CellsBelowX() 

Dim arrayRowNumbers() As Variant 
arrayRowNumbers = Array(8, 18, 28) ' <-- "Specific Rows" 

Dim intRow As Integer 
Dim objCell As Range 

For intRow = 0 To UBound(arrayRowNumbers) 

    For Each objCell In ThisWorkbook.ActiveSheet.Rows(arrayRowNumbers(intRow)).Cells 

     Debug.Print objCell.Address & " : " & objCell.Value 

     If objCell.Text = "" Then Exit For ' <-- Quit the row after finding an empty cell 
     If objCell.Value = "X" Then 

      With Range(objCell.Offset(1), objCell.Offset(1)) 
       With .Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .Color = 65535 
        .TintAndShade = 0 
        .PatternTintAndShade = 0 
       End With 
       With .Font 
        .Color = -16776961 
        .TintAndShade = 0 
       End With 
      End With 

      With Range(objCell.Offset(2), objCell.Offset(2)) 
       With .Font 
        .ColorIndex = xlAutomatic 
        .TintAndShade = 0 
       End With 
      End With 

      With Range(objCell.Offset(3), objCell.Offset(3)) 
       With .Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .Color = 10079487 
        .TintAndShade = 0 
        .PatternTintAndShade = 0 
       End With 
       With .Font 
        .Color = -16776961 
        .TintAndShade = 0 
       End With 
      End With 

      With Range(objCell.Offset(4), objCell.Offset(4)) 
       With .Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .Color = 13434828 
        .TintAndShade = 0 
        .PatternTintAndShade = 0 
       End With 
       With .Font 
        .Color = -16776961 
        .TintAndShade = 0 
       End With 
      End With 

      With Range(objCell.Offset(5), objCell.Offset(6)) 
       With .Font 
        .ColorIndex = xlAutomatic 
        .TintAndShade = 0 
       End With 
      End With 

      With Range(objCell.Offset(7), objCell.Offset(8)) 
       With .Font 
        .Color = -16776961 
        .TintAndShade = 0 
       End With 

      End With 

     End If 

    Next objCell 

Next intRow 

End Sub