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

我正试图自动化在excel中的形状依赖于表中的值。 我采取的方法是将表读入一个数组，然后我想用它来确定如何着色形状。 我遇到的问题是当我使用数组来select一个形状，它会出现，我得到一个数组索引号，而不是实际值。

因为我花了几个小时试图find一个没有运气的结果，所以我会大大地指出正确的方向。

表格数据：

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

你不需要这个全局variables。 更简单的版本可能是这样的：

 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 

如果你真的想分割成独立的子文件，那么你应该使用参数来代替全局variables：

例如

 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 

Answer 2

这可能会起作用：

 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