delete all cells of a certain color

醉酒当歌 提交于 2019-12-25 04:13:52

问题


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). 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

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)

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.


回答1:


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 



回答2:


you coudl use Range object Autofilter() method with xlFilterFontColor operator;

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



回答3:


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



回答4:


Something like following where all qualifying cells are gathered together, using Union, and deleted in one go. 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



来源:https://stackoverflow.com/questions/52332406/delete-all-cells-of-a-certain-color

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!