Question

我正在尝试根据表中的值自动着色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

非常感谢。

Answer 1

这可能会奏效：

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

Answer 2

你不需要全局变量。更简单的版本可能是：

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

如果你真的想分成单独的潜艇，那么你应该使用参数来代替全局：

E.g。

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

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

2 个答案: