删除所有特定颜色的单元格

4

这似乎相对简单,而且据我所知,是可以实现的。但我似乎无法弄清楚或在互联网上找到我要找的东西。

我有一些Excel数据在A列中,其中一些数据是蓝色的(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

我在多个网站上找到了这个解决方案,但是当我运行它时,好像什么也没有发生。


1
您的意思是给定单元格中的某些数据不同颜色吗?此外,如果应用于单元格,它是条件格式还是常规填充? - QHarr
这不是条件格式,而是从Word文档中复制粘贴的。一个单元格只包含一种颜色。例如,A1=蓝色字体,A2=红色字体,A3=绿色字体,然后接下来的4个单元格可能是蓝色...然后接下来的2个可能是绿色...等等... - XCELLGUY
1
我手动重新创建了这个,你的宏对我很有效,它清除了任何颜色为0,0,255的单元格,你确定表格是正确的吗? - Ricards Porins
我认为你误解了...单元格的背景颜色是白色(没有颜色),但文本是蓝色(字体颜色)。 - XCELLGUY
单元格中所有字符的字体颜色是否相同? - DisplayName
显示剩余2条评论
4个回答

4

这是基础知识,如果你的蓝色字体单元格没有被删除,则字体颜色不同。根据您的需要更改范围。

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 

好的,这个可以运行了...我不得不在开头添加“dim cel as range”,并将“.delete”更改为“.clearcontents”,否则所有内容都会向上移动...而我不想要那样...我将范围更改为A:A,因为我不知道有多少行,它会变化...它可以工作...但是速度很慢...可能是QHarr在下面指出的原因,但我无法让他的方法起作用。 - XCELLGUY
复制,只需提供基本代码,“删除”是因为它出现在你的问题中。我很高兴您能够修改它以满足您的需求。 - GMalc
我将发布最终代码。我能够使用先前生活中的代码片段,找到最后一行,这比 A:A 范围要快得多。 - XCELLGUY

1

下面类似的操作将所有符合条件的单元格使用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


已经有一段时间了,但我实际上正在寻找一种一次性删除数万行的方法,如果我没记错,大型联合查询可能会有问题并且速度较慢 - 这只是需要考虑的一些事情。 - user1274820

1
您可以使用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

1
我不想删除行...只想删除单元格内的文本。 - XCELLGUY
@XCELLGUY,如果有人试图帮助你,请给予适当的反馈会更好。 - DisplayName

0
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

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接