Question

下面的代码中有两个FOR EACH循环。第一个FOR循环遍历第一个数组（形状1，形状2，形状3）。第二个FOR循环循环通过第二个数组（0.3,0.4,0.5）。

形状1 0.3
形状2 0.4
形状3 0.5

第二个FOR循环根据第二个数组的值为工作表上的形状着色。问题是我的所有形状都用第一个值（即0.3）着色。我希望Shape 1基于0.3着色，Shape 2基于0.4，依此类推。谢谢你帮助我。

Private Sub Worksheet_Calculate()
    Dim arr1
    Dim arr2
    Set arr1 = Worksheets("Sheet2").Range("valueforarr1")
    Set arr2 = Worksheets("Sheet2").Range("Valueforarr2")
    Dim c, d As Range
    For Each c In arr1
        c = Replace(c, " ", "_")
        MsgBox c

        For Each d In arr2
            If d >= 0.2 And d <= 0.3 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
                Exit For
            ElseIf d > 0.3 And d <= 0.4 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(218, 238, 243) 
                Exit For
            ElseIf d > 0.4 And d <= 0.5 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(183, 222, 232) 
                Exit For
            ElseIf d > 0.5 Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(146, 205, 220) 
                Exit For
            ElseIf d Is Nothing Then
                Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(255, 255, 255) 
                Exit For
            End If
        Next d
    Next c
End Sub

Answer 1

嗯..我想你的问题是第二个循环。

取第一个Shape并将其与第二个Range-loop

的所有值匹配

你的循环正在做什么：

形状1 - ＆gt; 0.3

形状1 - ＆gt; 0.4

形状1 - ＆gt; 0.5

与Shape 2相同

形状2 - ＆gt; 0.3

形状2 - ＆gt; 0.4等。

因此，如果我正确，它始终是Range2的最后一个值

Dim intRow As Integer
intRow = 1
For Each c In arr1
        c = Replace(c, " ", "_")
        MsgBox c
            If Worksheets("Sheet1").Cells(intRow,2).value = "0.3" Then
            Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
            Exit For
            If Worksheets("Sheet1").Cells(intRow,2).value = "0.4" Then
            Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
            Exit For
            If Worksheets("Sheet1").Cells(intRow,2).value = "0.5" Then
            Worksheets("Sheet1").Shapes(c).Fill.ForeColor.RGB = RGB(237, 247, 249) 
            Exit For
intRow=intRow+1
Next c

Answer 2

我认为这将满足您的需求。您需要更改Set myShapes = ...和Set myValues = ...行以指向您的范围。

Sub Worksheet_Calculate()
  Dim myShapes As Range
  Set myShapes = Worksheets("Sheet1").Range("A1:A5")
  Dim myValues As Range
  Set myValues = Worksheets("Sheet1").Range("B1:B5")

  For i = 1 To myShapes.Rows.Count
    Select Case myValues.Rows(i)
      Case Is = 0.3
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(237, 247, 249)
      Case Is = 0.4
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(218, 238, 243)
      Case Is = 0.5
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(183, 222, 232)
      Case Is > 0.5
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(146, 205, 220)
      Case Else
        Worksheets("Sheet1").shapes(myShapes(i)).Fill.ForeColor.RGB = RGB(255, 255, 255)
    End Select
  Next i
End Sub

一个注意事项：

您调用的数组（arr1，arr2）实际上是Range个对象。

如何在TWO FOR Each循环中循环遍历两个数组

2 个答案: