这似乎相对简单,据我所知,这是可能的。但是我似乎无法弄清楚或者无法在互联网上找到我想要的东西。
我在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
我在几个地方在网上找到它作为解决方案,但是当我运行它时,似乎什么都没有发生。
答案 0 :(得分: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 :(得分: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
答案 2 :(得分:0)
类似于以下步骤,使用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