简体   繁体   English

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

[英]delete all cells of a certain color

This seems relatively simple and as I understand, it is possible. 这似乎相对简单,据我了解,这是可能的。 But I can't seem to figure it out or find exactly what I am looking for on the internet. 但是我似乎无法弄清楚或者无法在互联网上找到我想要的东西。

I have some excel data in column A and some of the data is blue (0,0,255), some is red (255,255,255), some is green (0, 140, 0). 我在A列中有一些excel数据,一些数据是蓝色(0,0,255),一些数据是红色(255,255,255),一些数据是绿色(0,140,0)。 I want to delete all blue data. 我要删除所有蓝色数据。

I was told that: 有人告诉我:

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

Would give me the colors... but when I run that it says invalid use of the property and highlights .color 会给我颜色...但是当我运行它时,它说该属性无效使用并突出显示.color

Instead I clicked on the: Font color drop down then more colors then custom colors then I can see that the data in blue is at (0,0,255) 相反,我单击了以下内容:字体颜色下拉菜单,然后是更多颜色,然后是自定义颜色,然后我看到蓝色的数据为(0,0,255)

So then I tried: 因此,我尝试了:

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

I found this on the web as a solution in several places but when I run it, nothing seems to happen. 我在多个地方在网络上找到了此解决方案,但是当我运行它时,似乎什么都没有发生。

you coudl use Range object Autofilter() method with xlFilterFontColor operator; 您可以使用xlFilterFontColor运算符使用Range对象的Autofilter()方法;

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

This is basic, if your cells with blue font are not deleted then the font is a different color. 这是基本操作,如果未删除具有蓝色字体的单元格,则该字体是另一种颜色。 Change the range to meet your needs. 更改范围以满足您的需求。

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

Updated to allow user to select the first cell in the column with the font color, obtain the font color, and clear all the cells that match the font color. 已更新,以允许用户选择带有字体颜色的列中的第一个单元格,获取字体颜色,并清除所有与字体颜色匹配的单元格。

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 

Something like following where all qualifying cells are gathered together, using Union , and deleted in one go. 遵循以下步骤,使用Union将所有符合条件的单元格聚集在一起,并一次性删除。 If deleting entire rows individually, you always need to loop backwards. 如果要单独删除整个行,则始终需要向后循环。 Deleting/clearing in one go is more efficient. 一键删除/清除效率更高。

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

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM