VBA Excel - 找到一个单元格并格式化下面的单元格

时间:2017-04-22 12:44:41

标签: excel vba excel-vba

我尝试创建代码以查找包含0的特定行中的单元格,然后将直接格式化下面的8个单元格以获得白色背景和白色字体。基本上使细胞不可见。理想情况下,如果搜索到的单元格中有X,我希望能够将8个单元格更改回原始格式。有什么帮助吗? -Thanks

Sample Data

很遗憾,我是新用户,无法显示示例图片,因此请点击上面的链接。

2 个答案:

答案 0 :(得分:0)

你还没有回答我们的问题,所以以下内容可能不是你想要的......但它应该是一个好的开始。

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

答案 1 :(得分:0)

谢谢史蒂夫!我很抱歉在过去的几个小时内没有回应。我和家人在地球日清理工作。

我稍微改了一下,看看&#34;特定的行&#34;这是8,18和28,它按预期工作。然后,我添加了第二个宏,如果行中存在X而不是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