[英]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.