Question

我在Excel工作簿中的一组中有4个形状，我想要的是当我将2个形状涂成黄色时，单元格（6,21）将显示为1，单元格（6,22）将显示为2，其他2个形状我用蓝色，细胞（9,21）仍为0，细胞（9,22）为2。

下面是我在工作簿中应用的vba代码，但没有按照我的意愿工作。

Private Sub Worksheet_Activate()
Dim shp As Shape
Dim shprange As ShapeRange
Dim CountyellowShape As Long
Dim CountorangeShape As Long
Dim CountpinkShape As Long
Dim CountblueShape As Long

For Each shp In Sheet1.Shapes

    If shp.Type = msoGroup Then
        Set shprange = shp.Ungroup
        Set oMyGroup = shprange.Group

        If shprange.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountChildShapeYELLOW = CountChildShapeYELLOW + 0.5
        If shprange.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountChildShapeORANGE = CountChildShapeORANGE + 0.5
        If shprange.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountChildShapePINK = CountChildShapePINK + 0.5
        If shprange.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountChildShapeBLUE = CountChildShapeBLUE + 0.5

    End If
Next shp

For Each shp In Sheet1.Shapes
    If shp.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountShapeYELLOW = CountShapeYELLOW + 0.5
    If shp.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountShapeORANGE = CountShapeORANGE + 0.5
    If shp.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountShapePINK = CountShapePINK + 0.5
    If shp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountShapeBLUE = CountShapeBLUE + 0.5
Next shp

Sheet1.Cells(6, 21) = CountShapeYELLOW + CountChildShapeYELLOW
Sheet1.Cells(7, 21) = CountShapeORANGE + CountChildShapeORANGE
Sheet1.Cells(8, 21) = CountShapePINK + CountChildShapePINK
Sheet1.Cells(9, 21) = CountShapeBLUE + CountChildShapeBLUE


    For Each shp In Sheet1.Shapes
    If shp.Type = msoGroup Then
        Set shprange = shp.Ungroup
        For Each grpShp In shprange

          If grpShp.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountChildShapeYELLOW = CountChildShapeYELLOW + 0.5
          If grpShp.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountChildShapeORANGE = CountChildShapeORANGE + 0.5
          If grpShp.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountChildShapePINK = CountChildShapePINK + 0.5
          If grpShp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountChildShapeBLUE = CountChildShapeBLUE + 0.5
        Next grpShp
        shprange.Group
    Else
      If shp.Fill.ForeColor.RGB = RGB(255, 255, 0) Then CountShapeYELLOW = CountShapeYELLOW + 0.5
      If shp.Fill.ForeColor.RGB = RGB(255, 153, 0) Then CountShapeORANGE = CountShapeORANGE + 0.5
      If shp.Fill.ForeColor.RGB = RGB(255, 102, 153) Then CountShapePINK = CountShapePINK + 0.5
      If shp.Fill.ForeColor.RGB = RGB(0, 176, 240) Then CountShapeBLUE = CountShapeBLUE + 0.5
    End If
Next shp

Sheet1.Cells(6, 22) = CountShapeYELLOW + CountChildShapeYELLOW
Sheet1.Cells(7, 22) = CountShapeORANGE + CountChildShapeORANGE
Sheet1.Cells(8, 22) = CountShapePINK + CountChildShapePINK
Sheet1.Cells(9, 22) = CountShapeBLUE + CountChildShapeBLUE

End Sub

提前感谢。 Wiz Lee

Answer 1

下面的代码查看工作表中每个形状的填充颜色，并使用您指定的4种颜色计算形状的数量。结果将在数组ColorCount（1到4）中。其他颜色的形状将被忽略。

Private Sub Worksheet_Activate()
    ' 18 Nov 2017

    Dim Shp As Shape
    Dim ColorCount(1 To 4) As Long
    Dim n As Long

    With Sheet1
        For Each Shp In .Shapes
            On Error Resume Next
            n = Application.Match(Shp.Fill.ForeColor, _
                Array(39423, vbYellow, 10053375, 15773696), 0)
                ' 1 = orange, 2 = yellow, 3 = pink, 4 = blue
            If Err.Number = 0 Then
                ColorCount(n) = ColorCount(n) + 1
            End If
        Next Shp

        For n = 1 To 4
            Debug.Print n, Split("Orange yellow pink blue")(n - 1) & ": " & ColorCount(n)
        Next n
'        .Cells(6, 22) = CountShapeYELLOW + CountChildShapeYELLOW
'        .Cells(7, 22) = CountShapeORANGE + CountChildShapeORANGE
'        .Cells(8, 22) = CountShapePINK + CountChildShapePINK
'        .Cells(9, 22) = CountShapeBLUE + CountChildShapeBLUE
    End With
End Sub

上面的代码将计数打印到立即窗口（Debug.Print），仅用于测试目的。将结果转换为要写入工作表的值的算法在您的问题中没有充分解释。显然，这种转换必须在完成计数之后并且在将结果写入工作表之前进行。也许，随着手中的数量，你将能够做到这一点。另外，请解释你想要写在表格上的意思..

Answer 2

enter link description here

你能打开这个链接吗？由于声誉要求，我没有资格上传图片。

计数不同颜色的形状组

2 个答案: