Excel VBA-每次单击宏时切换行突出显示

时间:2013-06-10 18:15:01

标签: excel vba excel-vba

如果特定列中有任何空白文本,我有一个突出显示行的宏。此宏用于突出显示用户需要引起注意的区域。通过单击相同的宏按钮,我希望能够在更改后取消突出显示这些行。

我该怎么做?

这是当前的宏:

Sub Macro13() 
       With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With ActiveSheet
       .Select
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False

        Firstrow = 2
        LastRow = .Cells(.Rows.Count, "M").End(xlUp).Row

        For Lrow = LastRow To Firstrow Step -1

             With .Cells(Lrow, "M")
                 If .Value = "" Then
                    .EntireRow.Interior.ColorIndex = 3
                End If
             End With


        Next Lrow
    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

我的想法是,在宏的开头,检查是否有任何行突出显示为红色。如果是这样,运行一个迭代遍历所有列的新循环,删除单元格突出显示,然后在完成该循环后,中断宏。尽管如此,这很难看并且充满了错误。

Sub Macro13() 'Checks for Incorrect Countries

   With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

With ActiveSheet
   .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False

    Firstrow = 2
    LastRow = .Cells(.Rows.Count, "M").End(xlUp).Row

    FirstrowA = 2
    LastRowA = .Cells(.Rows.Count, "M").End(xlUp).Row

    For Lrow = LastRow To Firstrow Step -1

         With .Cells(Lrow, "M")
             If .EntireRow.Interior.ColorIndex = 3 Then
                   For LrowA = LastRowA To FirstrowA Step -1
                            .EntireRow.Interior.ColorIndex = xlColorIndexNone
                             Next LrowA
                    End
                Exit Sub
             End If


             If .Value = "" Then
                .EntireRow.Interior.ColorIndex = 3
            End If
         End With
    Next Lrow
End With

ActiveWindow.View = ViewMode
With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With

End Sub

2 个答案:

答案 0 :(得分:1)

之前我遇到过类似的问题,条件格式化对我来说效果不佳。我使用了类似的东西:

Sub CheckAndHighlight(area As Range, Optional ByVal searchValue As String = "")

Application.ScreenUpdating = False

Dim r As Range
For Each r In area
    r.EntireRow.Interior.ColorIndex = 0

    If r.Value = searchValue Then
    r.EntireRow.Interior.ColorIndex = 3
    End If
Next

Application.ScreenUpdating = True

End Sub

答案 1 :(得分:1)

这应该可以帮到你。我添加了一个循环,在开始突出显示空格之前查找任何格式。如果找到红色的东西,它会清除整个红色格式并提出一个标志(Tracker = True)。引发该标志时,宏不会 格式化空白单元格的行为红色。我测试了它,它对我有用。

Sub Macro13()
   With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

With ActiveSheet
   .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False

    Firstrow = 2
    LastRow = .Cells(.Rows.Count, "M").End(xlUp).Row

    Dim Tracker As Boolean
    Tracker = False
    For Lrow = LastRow To Firstrow Step -1
        If .Cells(Lrow, "M").EntireRow.Interior.ColorIndex = 3 Then
            .Cells.Interior.ColorIndex = 0
            Tracker = True
            Exit For
        End If
    Next Lrow

    If Tracker = False Then
        For Lrow = LastRow To Firstrow Step -1

            With .Cells(Lrow, "M")
                If .Value = "" Then
                    .EntireRow.Interior.ColorIndex = 3
                End If
            End With

        Next Lrow
    End If
End With

ActiveWindow.View = ViewMode
With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With
End Sub