アクティブシートのテキストボックスの中の数字を正規表現を使ってコンマ付き数字に変える

注意点

複数の行にまたがっている数字はうまく変換できない可能性があります。
Format関数で変換するので、整数位が15桁の整数まで対応します。それ以上はExcelが対応していません。
半角数字が対象で、全角は対象にしていません。
全シートを対象にテキストボックスで正規表現を用いると予期しない変換を起こす危険があるため、アクティブシートのテキストボックスのみ対象にしています。
コード中まいなすとひらがなにしているのは可読性を高めるためでタイポではありません。

動作のながれとポイント

アクティブシートのShapeをFor Eachでチェックしてテキストボックスを探す。この時のタイプはmsoTextBoxであること
テキストボックスの文字列をいったん全部取得する。このときTextFrame2を使う。PublisherなどはTextFrameなのだが、Excelは異なっている。
正規表現で4種類のものを探す。任意の単語境界の前にある数字。行頭は前に何も文字がない数字の連続、それ以外は数字以外のものが来たときから任意の単語境界までの数字の連続を検索する。
このときマイナスがついていてもマッチするので場合分けする
さらに小数点がある場合を除外
マイナスかどうかで場合分け
マイナスではない場合、1文字目が数字かどうかをユーザー定義関数で判定
マッチした文字をFormatでコンマ付きに変換"#,##0"
これを繰り返し、最後にテキストボックスの文字列を入れなおす。

コード

addCommaXlTxtBox

Sub addCommaXlTxtBox()
'For Excel
'VBScript Regular Expression 5.5 Reference Setting
'ActiveSheetのすべてのテキストボックスの数字をコンマ付きに変換する
'小数点があっても区別する
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet 'ActiveSheetのみに制限しています
Dim shp As Excel.Shape
Dim REG As RegExp: Set REG = New RegExp
Dim buf As String, buf1 As String, buf2 As String
Dim tF2 As Excel.TextFrame2, i As Long, ileng As Long
Dim M As Match, Ms, sMs As SubMatches, m2 As Match
For Each shp In ws.Shapes
If shp.Type = msoTextBox Then
shp.Select 'テキストボックスを選択する
Set tF2 = shp.TextFrame2 'ExcelはTextFrame2になる
buf = tF2.TextRange.Text ’文字箱(テキストボックス)の文字をいったん全部読み込む
With REG
Debug.Print buf
.Global = True
.MultiLine = True
.Pattern = "([^0-9][0-9]+\b|[0-9]+\b|[^0-9][0-9]+\.\d{1,}\b| [0-9]+\.\d{1,}\b)"
'([^0-9][0-9]+\b 数字以外と数字の連続で任意の単語境界
'[0-9]+\b数字の連続で任意の単語境界
'[^0-9][0-9]+\.\d{1,}\b数字以外と数字の連続(小数点を含む)で任意の単語境界
'[0-9]+\.\d{1,}\b 数字と小数点、その下に1つ以上の数字の連続のあとに任意の単語境界
Set Ms = .Execute(buf): Debug.Print Ms.Count '検索して適合集合の作成
For i = 0 To Ms.Count - 1 'ポイント:マッチ順に変換するため文頭からカウントする
Set M = Ms.Item(i)
'小数点が頭にある場合はこんまがいらないのでカットする
If Left(M.Value, 1) <> "." Then
'まいなすではないとき
If Left(M.Value, 1) <> "-" Then
buf1 = M.Value
If CheckIsNumber(buf1) = True Then
'1文字目が数字ならそのまま1回だけ変換する
buf = Replace(buf, M.Value, Format(buf1, "#,##0"), 1, 1, vbTextCompare)
Else
'1文字目が数字でないなら2文字目からFormatで変換し、1文字目の数字以外のものを付ける
buf1 = Mid(M.Value, 2, M.Length)
buf = Replace(buf, M.Value, Mid(M.Value, 1, 1) & Format(buf1, "#,##0"), 1, 1, vbTextCompare)
End If
Else
'まいなすのとき
buf1 = Mid(M.Value, 2, M.Length)
buf = Replace(buf, M.Value, Left(M.Value, 1) & Format(buf1, "#,##0"), 1, 1, vbTextCompare)
End If
End If

Next i
tF2.TextRange.Text = ""
tF2.TextRange.Text = buf ’変換後の文字列をいれる
Exit Sub
End With
End If
Next
End Sub

Function CheckIsNumber(str As String) As Boolean
'最初の文字が数字か否かを確認する関数
'文字列として数字が入る
Dim ile As Long
Dim Rex As RegExp: Set Rex = New RegExp
On Error Resume Next
'型変換をしてエラーが出るかを確認する
ile = Mid(CStr(str), 1, 1)
If Err.Number <> 0 Then
'エラーが発生したら数字ではない
CheckIsNumber = False: Exit Function
Else
'長整数型に変換できれば数字
CheckIsNumber = True: Exit Function
End If
End Function

アドインにいれてもいいかもしれない

これはとても便利なのでアドインにいれてもいいと思う。
すでにいくつか紹介しているが、アドインの作り方もリンクがあるので参考にしてください。

入力した文字列を式にするマクロ
 移動方向を切り替えるマクロ