[[20260719200417]]　『数字の数と楕円の数が一致しているか。』（東九）　ページの最後に飛ぶ

『数字の数と楕円の数が一致しているか。』（東九）

   |[A]                                                   
[3]| ➀ りんご ➁ パイナップル ➂ バナナ ➃ なし ➄ サクランボ

数字を楕円で囲んでいます。
マクロで数字の数と楕円の数が一致しているかチェックすることは可能でしょうか。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

マクロでActiveSheetにあるオートシェイプの楕円の数をカウントすることは可能ですが、
「数字の数」というのは何を指しているのでしょう？
質問文中の例を用いて、詳しい説明をされると回答が寄せられるのでは。

 Sub test()
    Dim n&, shp As Object
    For Each shp In ActiveSheet.Shapes
        If shp.AutoShapeType = msoShapeOval Then n = n + 1
    Next
    MsgBox n
 End Sub
（硯） 2026/07/19(日) 21:28:53

 A3セルに入力の数字の数と、A3セル上に配置の楕円の数を知りたいってことですか？

 Sub Sample()
    Dim rng As Range: Set rng = ActiveSheet.Range("A3")
    Dim chr As String, shp As Shape
    Dim i As Long, n1 As Long, n2 As Long

    chr = rng.Text
    For i = 1 To Len(chr)
        If "1" <= Mid(chr, i, 1) And Mid(chr, i, 1) <= "9" Then n1 = n1 + 1
    Next i

    For Each shp In ActiveSheet.Shapes
        If shp.AutoShapeType = msoShapeOval And _
           Not Intersect(rng, shp.TopLeftCell) Is Nothing Then n2 = n2 + 1
    Next shp

    MsgBox "数字は " & n1 & "個" & vbCrLf & "楕円は " & n2 & "個"

 End Sub
（通行人） 2026/07/20(月) 06:27:18

（硯）さんへ
＞「数字の数」というのは何を指しているのでしょう？
数字の個数と書けばよかったんですかね。
＞質問文中の例を用いて、詳しい説明をされると回答が寄せられるのでは。
気を付けます。

（通行人）さんへ
＞ A3セルに入力の数字の数と、A3セル上に配置の楕円の数を知りたいってことですか？
その通りです。

指摘された『詳しい説明』が抜けていますのでお二方のコードを参考にして作成してみます。

（東九） 2026/07/20(月) 09:15:48

返答ありがとうございました。

丸数字を用いているわけではなく、
数値にオートシェイプを重ねて丸数字を表現しているということですね。

詳しい事情はわかりませんが、丸数字で代用できない事情がおありだとすると、
例えば２桁、３桁の数値を楕円で覆ったり、
選択肢内に数値が存在したりするケースはあり得るのでしょうか。

その場合「数字の数と楕円の数が一致しているかチェックする」には、
正規表現を使って判断する必要があるかもしれませんが、
正規表現は詳しくないので、私は退散いたします。
（硯） 2026/07/20(月) 10:33:51

 数字が２桁以上の入力も有り得る場合、ご提示例のように数字の前後へスペースが入力されるのなら、
 スペース区切りで数字部を切出して数値判定すれば良いと思います。

      | [A]                                                   
   [3]| 1 りんご 91 パイナップル 101 バナナ 105 なし 201 サクランボ
       ^ ^      ^  ^            ^   ^      ^   ^    ^   ^

 Sub Sample2()
    Dim rng As Range: Set rng = ActiveSheet.Range("A3")
    Dim s As Variant, shp As Shape
    Dim i As Long, n1 As Long, n2 As Long

    s = Split(rng.Text, " ")
    For i = 0 To UBound(s)
        If IsNumeric(s(i)) Then n1 = n1 + 1
    Next i

    For Each shp In ActiveSheet.Shapes
        If shp.AutoShapeType = msoShapeOval And _
           Not Intersect(rng, shp.TopLeftCell) Is Nothing Then n2 = n2 + 1
    Next shp

    MsgBox "数字は " & n1 & "個" & vbCrLf & "楕円は " & n2 & "個"

 End Sub
（通行人） 2026/07/21(火) 05:45:54

作成完了しました。

10は1とてカウントするようにしています。
1～10まで使用することあり。この場合10個となります。
ActiveSheetのActiveCellを参照します。
図形名は使用しているレイアウト専用です。

Sub 数字と楕円の数チェック()

    Dim セル文字列 As String
    Dim 数字の塊数 As Long
    Dim 楕円数 As Long
    Dim シート As Worksheet
    Dim セル As Range
    Dim 図形 As Shape
    Dim 位置 As Long
    Dim 数字の中 As Boolean

    Set シート = ActiveSheet
    Set セル = ActiveCell

    セル文字列 = セル.Value

    '?@ セル内の数字を数える

    数字の塊数 = 0
    数字の中 = False

    For 位置 = 1 To Len(セル文字列)
        If Mid(セル文字列, 位置, 1) Like "#" Then
            If Not 数字の中 Then
                数字の塊数 = 数字の塊数 + 1
                数字の中 = True
            End If
        Else
            数字の中 = False
        End If
    Next 位置

    '?A アクティブセル上の楕円の数を数える

    楕円数 = 0
    For Each 図形 In シート.Shapes
        If 図形.Name Like "数字楕円*" Then
            If 図形.TopLeftCell.Address = セル.Address Then
                楕円数 = 楕円数 + 1
            End If
        End If
    Next 図形

    '?B 結果表示

    MsgBox _
        "セル内の数字の塊の数：" & 数字の塊数 & vbCrLf & _
        "セル上の楕円の数：" & 楕円数 & vbCrLf & _
        IIf(数字の塊数 = 楕円数, "一致しています", "一致していません")

End Sub

手動で数字の個数だけ楕円を作成している状況なので
時間があったら一括で数字の個数分の楕円を描くコードを作成します。

（東九） 2026/07/21(火) 16:39:37

コメント返信：

[ 一覧(最新更新順) ]

[[20260719200417]] 『数字の数と楕円の数が一致しているか。』（東九） ページの最後に飛ぶ

[[20260719200417]]　『数字の数と楕円の数が一致しているか。』（東九）　ページの最後に飛ぶ