如何使用条件形成VBA永久更改单元格的颜色?

时间:2018-08-10 22:01:11

标签: excel vba excel-vba encoding formatting

我想根据规则永久更改单元格的颜色。我在每列的前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

谢谢您的帮助!

1 个答案:

答案 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

输出 enter image description here