同一列但不同行的VBA循环答案

【问题标题】：VBA loop for same colums but different rows同一列但不同行的VBA循环
【发布时间】：2021-07-13 01:02:09
【问题描述】：

我有这个公式可以根据其他 2 个单元格的颜色为单元格着色：

Sub RatingColor()
If range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(146, 208, 80) Then
 range("J13").Interior.Color = RGB(146, 208, 80)
 ElseIf range("F13").Interior.Color = RGB(255, 255, 0) And range("H13").Interior.Color = RGB(146, 208, 80) Then
 range("J13").Interior.Color = RGB(146, 208, 80)
 
 ElseIf range("F13").Interior.Color = RGB(255, 192, 0) And range("H13").Interior.Color = RGB(146, 208, 80) Then
 range("J13").Interior.Color = RGB(255, 255, 0)
 ElseIf range("F13").Interior.Color = RGB(255, 255, 0) And range("H13").Interior.Color = RGB(255, 255, 0) Then
 range("J13").Interior.Color = RGB(255, 255, 0)
 ElseIf range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(255, 255, 0) Then
 range("J13").Interior.Color = RGB(255, 255, 0)
 
 ElseIf range("F13").Interior.Color = RGB(255, 192, 0) And range("H13").Interior.Color = RGB(255, 255, 0) Then
 range("J13").Interior.Color = RGB(255, 192, 0)
 ElseIf range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(255, 192, 0) Then
 range("J13").Interior.Color = RGB(255, 192, 0)
 ElseIf range("F13").Interior.Color = RGB(255, 255, 0) And range("H13").Interior.Color = RGB(255, 192, 0) Then
 range("J13").Interior.Color = RGB(255, 192, 0)
 
 ElseIf range("F13").Interior.Color = RGB(255, 192, 0) And range("H13").Interior.Color = RGB(255, 192, 0) Then
 range("J13").Interior.Color = RGB(255, 0, 0)
 ElseIf range("F13").Interior.Color = RGB(146, 208, 80) And range("H13").Interior.Color = RGB(255, 0, 0) Then
 range("J13").Interior.Color = RGB(255, 0, 0)
End If
End Sub

例如：

如果 F13 = 橙色且 H13 = 绿色，则 J13 = 黄色。

下一步是单元格 J14 变为橙色，因为绿色 + 橙色 = 橙色。等等等等。我需要创建一个循环，该循环遍历不同行中的相同列，检查这些条件并作用于以下行中的 Jn 单元格。

谢谢。

【问题讨论】：

标签： excel vba loops for-loop

【解决方案1】：

如果我们用 Cells(row, col) 语句替换所有 Range("") 语句会怎样。如何实现您的目标是否更明显？

Option Explicit

Sub RatingColor()
    
    With Worksheets("Sheet1")
    
        If .Cells(13, 6).Interior.Color = RGB(146, 208, 80) And .Cells(13, 8).Interior.Color = RGB(146, 208, 80) Then
            .Cells(13, 10).Interior.Color = RGB(146, 208, 80)
        
        ElseIf .Cells(13, 6).Interior.Color = RGB(255, 255, 0) And .Cells(13, 8).Interior.Color = RGB(146, 208, 80) Then
            .Cells(13, 10).Interior.Color = RGB(146, 208, 80)
            
        ElseIf .Cells(13, 6).Interior.Color = RGB(255, 192, 0) And .Cells(13, 8).Interior.Color = RGB(146, 208, 80) Then
            .Cells(13, 10).Interior.Color = RGB(255, 255, 0)
        
        ElseIf .Cells(13, 6).Interior.Color = RGB(255, 255, 0) And .Cells(13, 8).Interior.Color = RGB(255, 255, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 255, 0)
        
        ElseIf .Cells(13, 6).Interior.Color = RGB(146, 208, 80) And .Cells(13, 8).Interior.Color = RGB(255, 255, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 255, 0)
            
        ElseIf .Cells(13, 6).Interior.Color = RGB(255, 192, 0) And .Cells(13, 8).Interior.Color = RGB(255, 255, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 192, 0)
        
        ElseIf .Cells(13, 6).Interior.Color = RGB(146, 208, 80) And .Cells(13, 8).Interior.Color = RGB(255, 192, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 192, 0)
        
        ElseIf .Cells(13, 6).Interior.Color = RGB(255, 255, 0) And .Cells(13, 8).Interior.Color = RGB(255, 192, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 192, 0)
            
        ElseIf .Cells(13, 6).Interior.Color = RGB(255, 192, 0) And .Cells(13, 8).Interior.Color = RGB(255, 192, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 0, 0)
        
        ElseIf .Cells(13, 6).Interior.Color = RGB(146, 208, 80) And .Cells(13, 8).Interior.Color = RGB(255, 0, 0) Then
            .Cells(13, 10).Interior.Color = RGB(255, 0, 0)
        
        End If
    
    End With
    
End Sub

【讨论】：

【解决方案2】：

应用评级颜色

过程RatingColor1 和RatingColor2 说明了如何使用过程applyRatingColor。

Option Explicit

Sub RatingColor1()
    applyRatingColor ActiveSheet, 13, "F", 2 ' or...
    'applyRatingColor ActiveSheet, 13, 6, 2
End Sub

Sub RatingColor2()

    Const First As Long = 13
    Const Last As Long = 30 ' usually calculated

    Dim ws As Worksheet: Set ws = ActiveSheet ' You can do better.

    Application.ScreenUpdating = False
  
    Dim r As Long
    For r = First To Last
        applyRatingColor ws, r, "F", 2 ' or...
        'applyRatingColor ws, r, 6, 2
    Next r

    Application.ScreenUpdating = True

End Sub

Sub applyRatingColor( _
        ByVal ws As Worksheet, _
        ByVal RowNumber As Long, _
        ByVal FirstColumn As Variant, _
        ByVal ColumnOffset As Long)

    Dim cDat(0 To 9) As Variant
    cDat(0) = VBA.Array(RGB(146, 208, 80), RGB(146, 208, 80), RGB(146, 208, 80))
    cDat(1) = VBA.Array(RGB(255, 255, 0), RGB(146, 208, 80), RGB(146, 208, 80))
    cDat(2) = VBA.Array(RGB(255, 192, 0), RGB(146, 208, 80), RGB(255, 255, 0))
    cDat(3) = VBA.Array(RGB(255, 255, 0), RGB(255, 255, 0), RGB(255, 255, 0))
    cDat(4) = VBA.Array(RGB(146, 208, 80), RGB(255, 255, 0), RGB(255, 255, 0))
    cDat(5) = VBA.Array(RGB(255, 192, 0), RGB(255, 255, 0), RGB(255, 192, 0))
    cDat(6) = VBA.Array(RGB(146, 208, 80), RGB(255, 192, 0), RGB(255, 192, 0))
    cDat(7) = VBA.Array(RGB(255, 255, 0), RGB(255, 192, 0), RGB(255, 192, 0))
    cDat(8) = VBA.Array(RGB(255, 192, 0), RGB(255, 192, 0), RGB(255, 0, 0))
    cDat(9) = VBA.Array(RGB(146, 208, 80), RGB(255, 0, 0), RGB(255, 0, 0))
 
    Dim rDat As Variant
    rDat = VBA.Array(ws.Cells(RowNumber, FirstColumn), _
        ws.Cells(RowNumber, FirstColumn).Offset(, ColumnOffset), _
        ws.Cells(RowNumber, FirstColumn).Offset(, ColumnOffset * 2))

    Dim n As Long
    For n = 0 To UBound(cDat)
        If rDat(0).Interior.Color = cDat(n)(0) _
                And rDat(1).Interior.Color = cDat(n)(1) Then
            rDat(2).Interior.Color = cDat(n)(2)
            Exit For
        End If
    Next n

End Sub

【讨论】：

【解决方案3】：

' determine rules (+ - prefix for matching start, G - green, Y - yellow, O - orange, R - red)
Const RULEZ = "+GGG+YGG+OGY+YYY+GYY+OYO+GOO+YOO+OOR+GRR"

Const TESTRANGE = "F13:F16" ' in first column with colors

Sub RatingColor()   ' loop
    Dim cl As Range
    For Each cl In Range(TESTRANGE)
        setColor cl, cl.Offset(0, 2), cl.Offset(0, 4)   ' source clolors #1, #2 and destination cell
    Next
End Sub

Sub setColor(c1 As Range, c2 As Range, c3 As Range) ' source colors #1, #2 and destination cell
    Dim tColor ' Variant, initial value is Empty
    
    s = "+" & getColorChar(c1) & getColorChar(c2)   ' make the signature of 3 chars such as "+GY" for match in RULEZ
    If Len(s) = 3 Then
        pos = InStr(RULEZ, s)
        If pos > 0 Then clr = Mid(RULEZ, pos + 3, 1) ' if signature found in RULEZ then get next char - target color
    End If

    Select Case clr ' target color value from color letter
        Case "G"
            tColor = RGB(146, 208, 80)
        Case "Y"
            tColor = RGB(255, 255, 0)
        Case "O"
            tColor = RGB(255, 192, 0)
        Case "R"
            tColor = RGB(255, 0, 0)
    End Select
    
    If Not IsEmpty(tColor) Then c3.Interior.Color = tColor
End Sub

Function getColorChar(c As Range) As String ' color letter from color value
    Select Case c.Interior.Color
        Case RGB(146, 208, 80)
            getColorChar = "G"
        Case RGB(255, 255, 0)
            getColorChar = "Y"
        Case RGB(255, 192, 0)
            getColorChar = "O"
        Case RGB(255, 0, 0)
            getColorChar = "R"
    End Select
End Function

【讨论】：