dポイントプレゼントキャンペーン実施中!

エクセルで、オートシェイプの色別に個数をカウントすることは出来ますか?
結果をテキストで書き出し、一覧表にしたいです。
具体的に教えていただけると助かります。

A 回答 (2件)

添付画像①をご覧ください。


集計表はQchan1962さんがお示しになったコードもとに繰返しを入れたVBAで作成しています。
これはご質問者の以下の同様のご質問
https://oshiete.goo.ne.jp/qa/12671553.html
に回答したVBAです。
これだと図形の「色」で集計しているため、形は違うのですが、E2セルにある図形が「あ」に集計されています。
つまり、前回回答のVBAだと「形が異なっても色が一致していれば、形は無視して集計される」ということになります。
このような事態を回避するため「形も色も一致している場合に集計する」方法を考えでみました。
挿入する図形がオートシェイプであれば形状ごとに定数が割り当てられています。
以下は形状定数をと色を両方取得して比較することにより「形も色も一致している場合に集計する」というVBAに修正したものです。
このVBAで集計した結果が、添付画像➁です。
E2セルの画像は、集計表に存在しないので、この画像は集計表に集計されない画像ということになります。

Option Explicit
Sub Count_Shapes2()

Dim buf1 As String
Dim buf2 As String
Dim i As Long
Dim shp As Shape
Dim adrs As String
Dim ct As Long

For i = 3 To 9
ct = -1
adrs = "A" & i
For Each shp In ActiveSheet.Shapes
On Error Resume Next
If shp.TopLeftCell.Address(0, 0) = adrs Then
buf1 = shp.AutoShapeType
buf1 = buf1 & "-" & shp.Fill.ForeColor.RGB
End If
Err.Clear
Next shp
For Each shp In ActiveSheet.Shapes
buf2 = shp.AutoShapeType
buf2 = buf2 & "-" & shp.Fill.ForeColor.RGB
If buf1 = buf2 Then ct = ct + 1
Next shp
MsgBox adrs & "セルのシェイプと同じ形、同じ色の数は" & ct & "個です"
Range(adrs).Offset(0, 2).Value = ct
Next
End Sub
「オートシェイプを色別に個数をカウントする」の回答画像2
    • good
    • 0
この回答へのお礼

大変遅くなり申し訳ございません。
とてもわかりやすいご指導をありがとうございました。
これを参考に自分なりにいろいろと編集してみたいと思います。
本当にありがとうございました。

お礼日時:2021/12/03 14:07

こんばんは、


①オートシェイプを色別に個数をカウントすることは出来ますか?
出来ます。
②結果をテキストで書き出し、一覧表にしたいです。
可能です。
③具体的に教えていただけると助かります。
ご質問の趣旨が解りません。あなたは、開発者ですか?利用者ですか?
開発者なら、どこまでご自身で作れますか?

運用(利用)者なら、いつでもコミュニケーション取れる詳しい人かプロに作ってもらいましょう。
または、時間が許せば、自身で基本的な事を理解して開発者側になり質問するのが良いと思います。

①について
https://oshiete.goo.ne.jp/qa/12671553.html
の様にサンプルがA1にあった場合の一例、、
変数宣言は割愛

For Each shp In ActiveSheet.Shapes
On Error Resume Next
If shp.TopLeftCell.Address(0, 0) = "A1" Then buf = shp.Fill.ForeColor.RGB
Err.Clear
Next shp

For Each shp In ActiveSheet.Shapes
If shp.Fill.ForeColor.RGB = buf Then ct = ct + 1
Next shp
MsgBox "A1セルのシェイプと同じ色の数は" & ct - 1 & "個です"

②ついて割愛
範囲をループして結果を書き出せば良いです。
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています