如何在两个FOR FOR循环中循环两个数组

下面的代码中有两个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）着色。 我想要形状1是基于0.3的颜色，基于0.4的形状2等等。 感谢您帮助我。

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

我认为这将做你所需要的。 您将需要更改Set myShapes = ...并将Set myValues = ...行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对象。

Answer 2

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

您采取第一个形状，并与第二个范围循环的所有值匹配

你的循环是做什么的：

形状1 – > 0.3

形状1 – > 0.4

形状1 – > 0.5

与形状2相同

形状2 – > 0.3

形状2 – > 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