異なる色の図形グループの数を計算する

Question

Excelワークブックの1つのグループに4つの図形があります。黄色で2つの図形を表示すると、セル（6,21）が1になり、セル（6,22）が表示されます。 （9,21）はまだ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

は、あなたがこのリンクを開くことができます。..シートに書かれた何をしたいの意味を説明してください？ 私は評判要件のために画像をアップロードする資格はありません。