Question

Range("A:A").Select
For Each Cell In Selection
    If ActiveCell.Interior.Color = Excel.XlRgbColor.rgbOrange Then
        cell.clear
    End If
Next

Answer 1

这应该更好（在您的代码中，您总是检查活动单元格）：

Range("A:A").Select
For Each Cell In Selection
    If cell.Interior.Color = Excel.XlRgbColor.rgbOrange Then
        cell.clear
    End If
Next

你不需要选择范围，所以你也可以写：

For Each Cell In Range("A:A")
    If cell.Interior.Color = Excel.XlRgbColor.rgbOrange Then
        cell.clear
    End If
Next

Answer 2

此代码使用Find快速清除符合您所需格式的单元格

更新其他单元格的行是：
.FindFormat.Interior.Color = Excel.XlRgbColor.rgbOrange

Option Explicit
Sub FastFind()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel1 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for ", "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .FindFormat.Interior.Color = Excel.XlRgbColor.rgbOrange
    End With

    Set cel1 = rng1.Find("", , xlValues, xlPart, xlByRows, , , , True)
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.Find("", cel1, xlValues, xlPart, xlByRows, , , , True)
            Set rng2 = Union(rng2, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    If Not rng2 Is Nothing Then rng2.Clear

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With
End Sub

根据内部颜色删除工作表中的所有单元格

2 个答案: