我想根据规则永久更改单元格的颜色。我在每列的前2个值中使用了条件格式。可以将前2个单元格的颜色更改为红色,然后做到了,但是之后,我只需要复制并粘贴单元格的颜色,而不是实际的颜色公式。当我检查单元格的格式时,它说没有背景色。我需要复制这些颜色,然后将其粘贴到另一种销售产品中,仅将这些颜色粘贴。我问了一个朋友一个宏,这是他为我创建的宏,但是它与条件格式的作用相同:
Sub SortColoredCells()
Dim rng2 As Range
For Each rng2 In ActiveSheet.UsedRange.Columns
c_name = GetColumnLetter(rng2.Cells.Column)
ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add(Range(c_name & "2:" & c_name & "1000"), _
xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SetRange Range(c_name & "1:" & c_name & "1000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next
End Sub
谢谢您的帮助!
答案 0 :(得分:0)
此代码会将前两行的颜色更改为红色。右键单击工作表标签,选择view code
,然后将其粘贴到此处并按F5键运行代码:
Sub main()
'loop thru columns
For i = 1 To UsedRange.Columns.Count
'look for top values in each column cell by cell
Set Rng = Sheets("Ranked").UsedRange.Columns(i).Cells
'reset parameters
a = 0 'top 1 value
b = 0 '2nd top value
Set cella = Nothing
Set cellb = Nothing
For Each cell In Rng
If IsNumeric(cell) = True Then
If cell.Value > b Then
If cell.Value > a Then
b = a
Set cellb = cella
a = cell.Value
Set cella = cell
Else
b = cell.Value
Set cellb = cell
End If
End If
End If
Next cell
'color the cells
If Not cella Is Nothing Then cella.Interior.Color = vbRed
If Not cellb Is Nothing Then cellb.Interior.Color = vbRed
Next i
End Sub