Arrays 基于数组中的值的颜色形状

我正试图根据表格中的值在excel中自动着色形状。我采用的方法是将表格读入数组，然后我想用它来确定如何给形状着色。我遇到的问题是，当我使用数组选择一个形状时，似乎得到的是数组索引号，而不是实际值

我会非常感激一个指向正确方向的指针，因为我花了几个小时试图找到一个解决方案，但没有运气

表数据：

Shape   Value
AB      900
DD      99
DG      647
EH      513
FK      191
G       446
HS      369
IV      259
KA      601
KW      351
KY      23
ML      509
PA      987
PH      167
TD      325
ZE      873

VBA代码：

Public i As Variant
Public j As Integer

Function mkArray()

    Dim areaArr As Variant
    areaArr = Range("I1:J16").Value

    Sheets("Sheet1").Select
    For i = 1 To UBound(areaArr, 1)
        For j = 1 To UBound(areaArr, 2)
            Debug.Print areaArr(i, j)
        Next j
            Call colourShapes
    Next i
End Function

Sub colourShapes()

    If j >= 500 Then
        Call formatGreen
    Else
        Call formatRed
    End If
End Sub

Sub formatGreen()

    With ActiveSheet
        .Shapes(i).Fill.ForeColor.SchemeColor = 11
    End With
End Sub

Sub formatRed()

    With ActiveSheet
        .Shapes(i).Fill.ForeColor.SchemeColor = 2
    End With
End Sub

非常感谢。

这可能会奏效：

Sub myColor()

Dim rng As Excel.Range
Dim row As Excel.Range
Dim cell As Excel.Range

Set rng = Range("I2:J17")
i = 1

For Each row In rng.Rows

    myShapeName = row.Cells(1, 1).Value
    myShapeValue = row.Cells(1, 2).Value

    If myShapeValue >= 500 Then

        myFill = 11

    Else

        myFill = 2

    End If

    ActiveSheet.Shapes(i).Fill.ForeColor.SchemeColor = myFill

    i = i + 1


Next

End Sub

---

对此，您不需要全局变量。更简单的版本可能是：

Function mkArray()

    Const COLR_GREEN As Long = 11
    Const COLR_RED As Long = 2

    Dim areaArr As Variant, i As Long
    areaArr = ActiveSheet.Range("I1:J16").Value

    For i = 1 To UBound(areaArr, 1)

        Debug.Print areaArr(i, 1), areaArr(i, 2)
        Sheets("Sheet1").Shapes(areaArr(i, 1)).Fill.ForeColor.SchemeColor = _
                          IIf(areaArr(i, 2) > 500, COLR_GREEN, COLR_RED)

    Next i

End Function

如果您确实希望拆分为单独的子对象，则应使用参数代替全局对象：

例如

---

感谢您的回复，但这并不是我想要的，因为我不需要格式化数据所在的单元格（这些单元格将不可见），图形对应于地图上的区域（对象）。我需要给这些东西上色。好的，谢谢。我现在更明白了。我会发布另一个答案，我为此道歉。谢谢你的更新。这会将颜色应用于形状，但不会应用于正确的形状。我注意到它错过了AB的条目，所以我尝试将

myShapeName

设置为

myShapeName=row.Cells（0，1）.Value

和

myShapeValue

设置为

myShapeValue=row.Cells（0，2）.Value

。它没有捕获AB，但仍然不完全正确。。。我以后还有一次尝试。谢谢，这正是我想要实现的。。。比我想象的要简单。

Function mkArray()

    Dim areaArr As Variant, i As Long
    areaArr = ActiveSheet.Range("I1:J16").Value

    For i = 1 To UBound(areaArr, 1)

        ColorShape Cstr(areaArr(i, 1)), areaArr(i, 2)

    Next i

End Function


Sub ColorShape(shpName as string, shpVal)
    Const COLR_GREEN As Long = 11
    Const COLR_RED As Long = 2

    Sheets("Sheet1").Shapes(shpName).Fill.ForeColor.SchemeColor = _
                IIf(shpVal > 500, COLR_GREEN, COLR_RED)

End Sub