VBA将内部颜色更改为代码中未指定的随机颜色

时间：2013-12-31 21:44:29

标签： excel excel-vba colors vba

我创建了一个宏来根据不同的标准对销售交易进行颜色协调。范围是列F：R，具有未知数量的事务。我一直在使用AutoFilter来有条件地格式化数据。

它首先根据事务类型（销售，无效，授权）为整行着色，然后根据响应（已批准，已拒绝等）为整行着色。最后一步是为每个相应的交易着色实际的卡片类型（第I列）。我希望AMEX细胞是浅蓝色的，剩下的卡片类型（Discover，MC和Visa）是粉红色的。

当它为AMEX细胞染色时，它的效果非常好。当它继续着色剩余的卡片类型时，它们应该都是粉红色的，我首先看到一缕粉红色，然后它们都变成了深色的。我反复浏览了我的代码，无法弄清楚为什么Discover，MC和Visa的单元格会闪烁一秒钟，而当宏运行完毕后，所有的Discover，MC和Visa单元都是深蓝色。深蓝色的颜色代码/ RGB代码在代码中没有...如果有人可以帮助我，那将是不可思议的！我真的很难过！

注意：我希望我的代码不会太乱。 （例如，我的命名范围在这个宏上有点失控。）这是我第一次将VBA问题发布到论坛（或者显示任何人的代码，就此而言）。如果您有任何VBA建议，我很乐意改进!! 

Sub PayPalColor()
' PayPalColor Macro
' Color coordinate the PayPal Reports

'Add filters
Range("F1:R1").Select
Selection.AutoFilter

'Reset Used Range
Application.ActiveSheet.UsedRange

Dim LastestRow As Long
LastestRow = Range("K" & Rows.Count).End(xlUp).Row

'Sort TYPE alphabetically
Dim rRng As Range
Set rRng = Range("$F$2:$Q$" & LastestRow)
rRng.Sort key1:=Range("G2"), order1:=xlAscending, _
Header:=xlNo


With ActiveSheet.Range("$F$2:$Q$" & LastestRow)
' TYPE: AUTHORIZATION
Dim FilteredRange1 As Range
Dim rw1 As Range
.AutoFilter Field:=2, Criteria1:="Authorization"

    Set FilteredRange1 = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw1 In FilteredRange1.Rows
        If rw1.Row > FilteredRange1.Rows.Row Then
            'If visible cell, format row here
            With rw1.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 12566463
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next
        ActiveSheet.ShowAllData

' TYPE: CREDIT
Dim FilteredRange2 As Range
Dim rw2 As Range
.AutoFilter Field:=2, Criteria1:="Credit"

    Set FilteredRange2 = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw2 In FilteredRange2.Rows
        If rw2.Row > FilteredRange2.Rows.Row Then
            'If visible cell, format row here
            With rw2.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 16752607
    .TintAndShade = 0
    .PatternTintAndShade = 0
            End With
        End If
    Next
        ActiveSheet.ShowAllData

' TYPE: DELAYED CAPTURE
Dim FilteredRange3 As Range
Dim rw3 As Range
.AutoFilter Field:=2, Criteria1:="Delayed Capture"

    Set FilteredRange3 = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw3 In FilteredRange3.Rows
        If rw3.Row > FilteredRange3.Rows.Row Then
            'If visible cell, format row here
            With rw3.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 16768121
    .TintAndShade = 0
    .PatternTintAndShade = 0
            End With
        End If
    Next
        ActiveSheet.ShowAllData

' TYPE: VOID
Dim FilteredRange4 As Range
Dim rw4 As Range
.AutoFilter Field:=2, Criteria1:="Void"

    Set FilteredRange4 = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw4 In FilteredRange4.Rows
        If rw4.Row > FilteredRange4.Rows.Row Then
            'If visible cell, format row here
            With rw4.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 15513599
    .TintAndShade = 0
    .PatternTintAndShade = 0
            End With
        End If
    Next
        ActiveSheet.ShowAllData
End With


'Sort RESPONSE alphabetically
Dim rRng2 As Range
Set rRng2 = Range("$F$2:$Q$" & LastestRow)
rRng2.Sort key1:=Range("L2"), order1:=xlAscending, _
Header:=xlNo


With ActiveSheet.Range("$F$2:$Q$" & LastestRow)
' RESPONSE: DECLINED
Dim FilteredRange5 As Range
Dim rw5 As Range
.AutoFilter Field:=7, Criteria1:="Declined"

    Set FilteredRange5 = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw5 In FilteredRange5.Rows
        If rw5.Row > FilteredRange5.Rows.Row Then
            'If visible cell, format row here
            With rw5.Interior
  .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 192
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
With .Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
        End If
    Next
        ActiveSheet.ShowAllData

'RESPONSE: INVALID EXP
Dim FilteredRange5a As Range
Dim rw5a As Range
.AutoFilter Field:=7, Criteria1:="Invalid Exp"

    Set FilteredRange5a = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw5a In FilteredRange5a.Rows
        If rw5a.Row > FilteredRange5a.Rows.Row Then
            'If visible cell, format row here
            With rw5a.Interior
  .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 192
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
With .Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
        End If
    Next
        ActiveSheet.ShowAllData

' RESPONSE: CREDIT ERROR
Dim FilteredRange5b As Range
Dim rw5b As Range
.AutoFilter Field:=7, Criteria1:="Credit Error"

    Set FilteredRange5b = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    For Each rw5b In FilteredRange5b.Rows
        If rw5b.Row > FilteredRange5b.Rows.Row Then
            'If visible cell, format row here
            With rw5b.Interior
  .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 192
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
With .Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
        End If
    Next
        ActiveSheet.ShowAllData
End With

'clear background for card type column
Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

'Sort CARD TYPE alphabetically
Dim rRng3 As Range
Set rRng3 = Range("$F$2:$Q$" & LastestRow)
rRng3.Sort key1:=Range("I2"), order1:=xlAscending, _
Header:=xlNo


With ActiveSheet.Range("I2:$I$" & LastestRow)
' CARD TYPE: AMEX
Dim FilteredRange6 As Range
Dim rw6 As Range
.AutoFilter Field:=4, Criteria1:="AMEX"

Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0
End With
    With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With
ActiveSheet.ShowAllData

' CARD TYPE: Discover
Dim FilteredRange111 As Range
Dim rw111 As Range
.AutoFilter Field:=4, Criteria1:="Discover"

Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
    .Pattern = xlSolid
    .Color = RGB(255, 51, 204)
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
    With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With
        ActiveSheet.ShowAllData

' CARD TYPE: MC
Dim FilteredRange121 As Range
Dim rw121 As Range
.AutoFilter Field:=4, Criteria1:="MC"

Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
    .Pattern = xlSolid
    .Color = RGB(255, 51, 204)
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
    With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With
        ActiveSheet.ShowAllData

' CARD TYPE: Visa
Dim FilteredRange122 As Range
Dim rw122 As Range
.AutoFilter Field:=4, Criteria1:="Visa"

Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
    .Pattern = xlSolid
    .Color = RGB(255, 51, 204)
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
    With Selection.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With
        ActiveSheet.ShowAllData

Range("F2").Select

End With
End Sub

3 个答案:

答案 0 :(得分：1)

当我遇到这样的问题时，我经常使用“Toggle Breakpoint”选项，该选项在我的VBA版本中位于Debug菜单中。也许在粉红色分配的位置添加一个断点，然后使用F8键，直到你到达发生蓝绿色/暗蓝绿色分配的代码行。我想知道暗青色是否可以设置为青色，然后选择/突出显示......

答案 1 :(得分：1)

我发现使用RGB颜色的问题较少，试试这个：

 .Color = RGB(127,187,199)

答案 2 :(得分：0)

建议您在没有VBA的情况下尝试此操作 - 在SO中有很多关于根据条件格式化行的答案。使用的常用公式如下所示：

=INDIRECT("$E"&ROW())=[Value]

从那里，您可以为单列添加其他条件格式。

相关问题
最新问题