删除某种颜色的所有单元格

Question

这似乎相对简单，据我了解，这是可能的。但我似乎无法弄清楚或在互联网上找到我正在寻找的确切内容。

我在 A 列中有一些 Excel 数据，其中一些数据是蓝色的 (0,0,255)，一些是红色的 (255,255,255)，一些是绿色的 (0, 140, 0)。我想删除所有蓝色数据。

有人告诉我：

Sub test2()
    Range("A2").DisplayFormat.Font.Color
End Sub

会给我颜色...但是当我运行它时，它说属性的使用无效并突出显示 .color

相反，我点击了： 字体颜色下拉 然后更多颜色 然后自定义颜色 然后我可以看到蓝色的数据在（0,0,255）

然后我尝试了：

Sub test()

Dim wbk As Workbook
Dim ws As Worksheet
Dim i As Integer
Set wbk = ThisWorkbook
Set ws = wbk.Sheets(1)

Dim cell As Range

With ws
    For Each cell In ws.Range("A:A").Cells
        'cell.Value = "'" & cell.Value
        For i = 1 To Len(cell)
            If cell.Characters(i, 1).Font.Color = RGB(0, 0, 255) Then
                If Len(cell) > 0 Then
                    cell.Characters(i, 1).Delete
                End If
                If Len(cell) > 0 Then
                    i = i - 1
                End If
            End If
        Next i
    Next cell
End With

End Sub

我在网上找到了几个地方的解决方案，但是当我运行它时，似乎什么也没发生。

Answer 1

这是基本的，如果你的蓝色字体的单元格没有被删除，那么字体是不同的颜色。更改范围以满足您的需求。

For Each cel In ActiveSheet.Range("A1:A30")
    If cel.Font.Color = RGB(0, 0, 255) Then cel.Delete
Next cel

更新为允许用户选择列中第一个具有字体颜色的单元格，获取字体颜色，并清除所有与字体颜色匹配的单元格。

Dim rng As Range
Set rng = Application.InputBox("Select a Cell:", "Obtain Range Object", Type:=8)

    With ActiveSheet
        Dim lr As Long
        lr = Cells(Rows.Count, 1).End(xlUp).Row

        Dim x As Long
        x = rng.Row

        For i = lr To x Step -1
            If .Cells(i, 1).Font.Color = rng.Font.Color Then .Cells(i, 1).Clear
        Next i
    End With 

Answer 2

您可以将Range 对象Autofilter() 方法与xlFilterFontColor 运算符一起使用；

Sub test()       
    With ThisWorkbook.Sheets(1)
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            .AutoFilter Field:=1, Criteria1:=RGB(0, 0, 255), Operator:=xlFilterFontColor
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).ClearContents
        End With
        .AutoFilterMode = False
        If .Range("A1").Font.Color = RGB(0, 0, 255) Then .Range("A1").ClearContents ' check first row, too (which is excluded by AutoFilter)
    End With
End Sub

Answer 3

类似于跟随所有符合条件的单元格聚集在一起，使用Union，并一次性删除。如果单独删除整行，则始终需要向后循环。一次性删除/清除效率更高。

Sub test()
    Dim wbk As Workbook, ws As Worksheet
    Dim i As Long, currentCell As Range, unionRng As Range

    Set wbk = ThisWorkbook
    Set ws = wbk.Worksheets("Sheet1")

    With ws
        For Each currentCell In .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)  '<==assuming actual data present
            If  currentCell.Font.Color = RGB(0, 0, 255) Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(currentCell, unionRng)
                Else
                    Set unionRng = currentCell
                End If
            End If
        Next
    End With
    If Not unionRng Is Nothing Then unionRng.Delete
End Sub

---

Answer 4

Option Explicit
Sub test2()

Dim cel As Range
Dim LR As Long

LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

For Each cel In ActiveSheet.Range("A1:A" & LR)

    If cel.Font.Color = RGB(0, 0, 255) Then cel.ClearContents
Next cel
End Sub