LoginSignup
0
0

More than 1 year has passed since last update.

Word VBA 数式の*/を✕÷に変えるマクロを使い、Wordでも無計算で値を出せるようにする(後編)

Last updated at Posted at 2021-05-30

前回からの続き

Word VBA 数式の*/を✕÷に変えるマクロを使い、Wordでも無計算で値を出せるようにする(前編)から続きます

Excelで計算

Wordに数式を打ちます
1,235.12*3円/㎡+(5/12)+2^2
選択状態で、次のコードを実行します
クリップボードに結果が入ります
Wordで
1,235.12*3円/㎡+(5/12)+2^2 =
とイコールをいれてCtrl+Vで出来上がります。
後は前回のマクロで*/を✕÷に変換します。
必要があるときは戻して計算します。結果についてはコンマ付き下二桁という表示形式を設定し、小数3位で四捨五入までしています。

マイナスは参照なし版は対応

マイナスは三角を使わないで-chrw(45)を使ってください。
テンキーのマイナスです。

参照なし版は対応しました

三角の他
上付ハイフンの打ち方について
チルダ~
全角オーバーライン ̄
アンダースコア_
まだあります
ハイフンに似てる文字の文字コード
Unicodeにあるハイフン/マイナス/長音符/波線/チルダのコレクション

参照なし版はイコール、スペース、改行にも対応しました

式を選択するときにイコールを選択することはありえます。
全てではありませんが、これを除去するようにしました。
最初にイコールがある場合は、式として認識されますが、後ろだと余計です
また、空白もエラーになりうるため削除します。
これも全部ではありません。
Wordで式を記述すれば、当然改行も入ります。
これも除去しました。

ExcelのEvaluateは癖がある

Excel VBAにおける伝家の宝刀。Evaluateの使い方
もともとExcelに置いても癖があります。

演算誤差

まずExcel自体が有効数字が15桁で、演算誤差が発生します。

255文字以内

Evaluateは255文字までしか使えません。

ExecuteExcel4Macro("EValuate(" & str & ")")とApplication.Evaluateの機能は同等

Visual Basic for Applications では、すべての Excel ワークシート関数が Application オブジェクトのメソッドとしてサポートされるわけではありません。

例として、 ExecuteExcel4Macroを使って、または関数を評価することで、Visual Basic マクロでATANワークシートを使うことができます。 x = Application.ExecuteExcel4Macro("Atan(12)") または x = Application.Evaluate("Atan(12)")

このように等しく扱われている。
Microsoftは恥ずかしくないのでしょうか。16bit時代の機能に64bitになったらエラーメッセージも出ない。こんな信じがたいバカげたことをやって褒められてるということはIT業界はバカばっかりですわ。

Excel4Macroは1992年に誕生しました。役立たないまでも豊富なエラーメッセージがいまのカスでしかないマイクロソフトと違い、丁寧なメッセージは品の良さと血の通った機能性を感じまさに{モダン」といえます。

1004 この数式には問題があります。

数式を入力していない場合は次の点に注意します。
最初の文字に等号 (=) やマイナス記号 (-) を使用している場合は、数式として認識されます。

? 入力内容: =1+1、セルの表示: 2

これを回避するには、先頭に単一引用符 ( ' ) を入力します。
1004 この名前の構文が正しくありません。

名前が次の規則を満たしていることをご確認ください:
- 先頭が英文字、ひらがな、カタカナ、漢字、またはアンダースコア (_) である。
- 空白または他の無効な文字が含まれていない。
- ブック内の既存の名前と競合していない。

こんなにたくさんのメッセージをExcel4Macroは出してくれます。

ところで、Excel4MacroがあればWord95でこんなことができたのでしょうか。
それは否定されます。当時のWord95はVBAは動きません。これまたWordBasicでした。
また正規表現も1999年に確立しています。
このため、このマクロは少なくとも2000年までは可能とは言えません。つまり、Word95あたりから使い始めた現在のMVP系ユーザーにはWordでEvaluateを使って計算させることで電卓を一切使わず結果を求めることで時短する。という発想がありません。だからサンプルとしてもあまりありません。また、Evaluateに計算させるには、コンマの除去、Excelでは無視されるはずの改行が、Wordで使うと無視されず、エラーになります。次の例をみてみます。

文字データーを計算させたい
解決済
質問者:0009
質問日時:2003/09/09 20:14
回答数:10件
質問させていただきます
よろしくお願します。
周りの人に聞いてもむりだと言われたのですが
一つのセルの中に (たとえば)
 30000×6÷0.53と文字として入力し、その答えを(339,623)隣のセルに円未満四捨五入して出したいと思っているのですがうまくいきません
いつも電卓を片手にエクセルに入力しているので
何とかしたいと思っているのですが
質問して無理だと言ってくださればあきらめもつきます
よろしくお願します。

ユーザー定義関数を使用する方法ですが、もし、これで宜しかったら次の手順で
テストしてみてください。

■ 操作手順
1.Alt + F11 または、メニューから[ツール] --> [マクロ]-->
  [Visual Basic Editor] をクリックします。
2.メニューから [挿入]--> [標準モジュール] をクリックします。
3.モジュールウィンドウに下記コード(6行)をコピーして貼り付けます。
4.Alt + Q (または、右上隅の×)でウィンドウを閉じ、シートに戻ります。
 これで STRENZAN 関数が使用できます。
( + や- も使えます。全角でもOK)
セルA1に 30000×6÷0.53 を入力します。

例えば、セルB1に =ROUND(STRENZAN(A1),0) の計算式を設定します。

これで B1には、文字列の演算結果を四捨五入し、339623 が表示されます。

Function StrEnzan(Shiki As String) As Variant
  Shiki = Replace(Shiki, "×", "*")
  Shiki = Replace(Shiki, "÷", "/")
  StrEnzan = Application.Evaluate(Shiki)
  Application.Volatile
End Function 

Office XPではApplication.Roundはすでにあったようですが、この関数は現在はちょっとだめでです。
確かに、質問に対しては十分な回答になっているでしょう。
しかし、VBAの正規表現が普及しておらず、StrConvやEvaluateの性質も資料がないため2003年当時ではやむを得ないのですが、現在ではコンマやかっこの処理は必要でしょう。
解答者は半角数字でコンマを抜いており、Evcaluateのを知っているようです。Roundをかけているので、演算誤差も知っています。
しかし、式を明示したいという人が、コンマを抜くとは考えられません。
また、好みの問題かもしれませんが、RoundをかけるよりはFormatの表示形式で四捨五入したほうがいいのではないでしょうか。
質問者は式を明示したいと思われます。明示していないRoundをかけるのはためらいがあります。
最もFormatで四捨五入すること自体がAccess等、Roundが違ったり、WordのようにRoundが使えない場合(差し込み印刷で演算誤差が出る場合がある)の必須スキルであり、知られていないのも仕方がない面はあります。

角カッコで略記できない

xlApp.[str]は効かないみたいです。

かっこが多すぎるとエラーになる

同じ計算結果が出る場合、かっこが多いとエラーになります。

{(4*3)-(2+3)/4)}+(3/4+1) 形が一致しません
4*3-((2+3)/4))+(3/4+1)
4*3-((2+3)/4))+((3/4)+1) Application.Evaluate エラー 2015 この式には問題があります 
' ((2+3)/4) <- ここが誤り
4*3-((2+3)/4))+((3/4)+1)

それでは正解は

4*3-(2+3)/4+(3/4+1)

計算結果が同じであれば、かっこが多すぎるとエラーになるときがあります。
というかまちがっているとだめみたいです。
抽象的な言い方ですが。うまく再現できません。

Verion History

V2.0

角カッコ(大かっこ)、中括弧はEvaluateが受け付けないことがわかり、ただのカッコに変換するようにしました

参照設定が必要なコード

Sub selectCalc()
' 2021/06/01 Patternを修正 V1.0→V2.0
' Reference Setting
' Microsoft Excel XX.0 Object Model
' Microsoft Fomrs 2.0
' ClipBordは一旦クリアされます
Dim wDoc As Word.Document: Set wDoc = ThisDocument
Dim str As String

Dim var
Dim xlApp As New Excel.Application
Dim j
Dim CB As New DataObject
Dim Reg As New RegExp
str = Selection.Text ' WordのDocument中で選択している数式を変数に代入
With Reg
.IgnoreCase = False
.Global = True
.Pattern = "\D/\D" ' 円/㎡はつまり非数字/非数字 mと2で表しているような場合はだめ
str = .Replace(str, "")
.Pattern = "(\,)" ' コンマ除去
str = .Replace(str, "")
' 角カッコ、中括弧をただのカッコに(Evaluateはエラーになるため)
.Pattern = "(\{|\[)"
str = .Replace(str, "(")
.Pattern = "(\}|\])"
str = .Replace(str, ")")

.Pattern = "([0-9\.]{1,}|[0-9]{1,}\.[0-9]{0,}|\)|\()(" & ChrW(10005) & ")([0-9\,\.]{1,}|\)|\()" 'カケルをアスタリスク
str = .Replace(str, "$1" & "*" & "$3")
.Pattern = "([0-9\.]{1,}|[0-9]{1,}\.[0-9]{0,}|\)|\()(" & ChrW(215) & ")([0-9\,\.]{1,}|\)|\()" 'カケルをアスタリスク chrw(215)
str = .Replace(str, "$1" & "*" & "$3")

.Pattern = "([0-9\.]{1,}|[0-9]{1,}\.[0-9]{0,}|\)|\()(÷)([0-9\,\.]{1,}|\)|\()" '÷をスラッシュ
str = .Replace(str, "$1" & "/ " & "$3")
.Pattern = "[^0-9/\.\+\-\*\^\(\)]" ' 12㎡*のような場合を除去
str = .Replace(str, "")
End With
If Len(str) >= 256 Then MsgBox "Evaluateは255文字までです", vbCritical, "エラー終了": Exit Sub

var = Format(xlApp.Evaluate(str), "#,##0.00") ' 四捨五入 ここは自分の出力したい書式に変える 有効数字は15桁 演算誤差の可能性あり
With CB
.Clear
.SetText var, 1
.PutInClipboard
End With
' Ctrl + V で貼り付け
End Sub

参照設定なしバージョン

Ver 6.0

  • 正規表現が効かない原因が半角に変換したときに? Chr(63)にすでに変わっているのが原因だと気付きました
  • このためマイナスに見える文字を変換するのはStrConvで半角に変換する前に行うようにしました。
  • このため全角の句読点も、コンマ、小数点に変換できるようになりました。
  • ただし、コンマは数字が3つ以上続くとき、小数点は数字と数字に挟まれたものだけです。
  • Evalは1=1の場合、Trueを返しますが、このマクロでは1-1と区別がつかないので、等号は削除しています。
  • Excelで失敗したときはAccessで試みるようにしました。
  • WorkSheetFuncitonやVBAの関数を使わないオプションを作りました。UseXLWorkSheetFunction = Falseにしてください。
  • XLAndWorkSheetFuncOrAcEvalWithVBA オプション:TrueでExcelが優先使用、FalseでVBAのCDECが使えるようにAccessを使用します
  • ただし、AccessがインストールされていないとXLAndWorkSheetFuncOrAcEvalWithVBA オプションは使えません。

Ver5.0

  • 日本語の文字が入る場合を考えて正規表現で除去するようにしました
  • なぜか正規表現で取り切れない文字があるのは最後に否定集合で除去できるようにしました
  • オプションでworkシート関数等を使わない場合、とExcelかアクセスを選べるようにしました。
  • この正規表現では取れない丸を小数点とした表記1。11.1に現在変換できません。

正規表現」、Replace
kannsuude
torikirenaib取り切れないユニコード文字

Ver4.0

  • 空白(半角u全角u+12288)を削除できるようにしました
  • 改行が含まれる場合(フィード、タブ等)も削できるようにしました
  • 現在のところ、空白、負数の表現の類似文字、記号について、正規表現(VBA RegularExpression)、VBA.Replace関数を含め、VBAではすべてのユニコード文字を除去できないこと、及びイコールでは類似の文字が多すぎるため、日本語で入力できる主なものを変換し、エラーが抑制されるようにしました。
  • 4.1 通貨単位が除去するようにしました

Ver3.0

  • Excel4Macro,AccessのEvalが使えるようにしました
  • コンマ、単位の表示の削除を見直して、Worksheet関数、Accessの場合はNzのようなAccessの独自関数を含むVBAの関数Cdate等が使えるようにしました。
  • Excelの場合はRoundが使えます。Accessの場合はおそらく偶数まるめでRoundは使わない方がいいです。
  • AccessはHome & Business のように製品に含まれず、インストールされない場合には使えません。
  • また、Accessは(365solo 64bit OS:10Home64、AdminAccount)-2147418113 要求された操作には管理者特権が必要です。で止まるときがあります。
  • ExecuteExcel4MacroとApplication.Evaluateは同等ですが、Excel4Maciroの方が詳細なエラーメッセージが出て、いかにマイクロソフトが手抜きで質の低いOfficeを作っているのかが如実にわかります。
  • しかし、ExecuteExcel4Macroはコードが長くなる上に、可読性に欠けます。
  • なので、通常はApplication.Evaluateを使用し、エラーが出る場合に、メッセージが豊富なExecuteExcel4Macroを使うようにしてください。
  • イコール系の文字を選択した場合でも削除するようにしました。

Ver 2.3
マイナス変換でマイナスに対応しました。
正規表現置換を関数化して、単純なものは関数処理にしました。

コード

selectCalc_NonRef
Sub SelectCalc_NonRef()
' For Word VBA
' Ver 6.0
' 選択している範囲が数式として評価できるなら、値をクリップボードで返す
' Ctrl+Vで答えを貼り付け
' Optionの指定
Const UseXLWorkSheetFunction As Boolean = True ' WorkSheetFuncitonやVBAの関数を使わないオプション
Const XLAndWorkSheetFuncOrAcEvalWithVBA As Boolean = True 'Tue:Excelをメインに使うか、VBAのコードがあるのでAccessを使うか
Const cnsFormatString = "#,##." ' 計算結果を出力する書式
' 変数の宣言
Dim wDoc As Word.Document: Set wDoc = ThisDocument
Dim str As String, buf As String
Dim var
Dim j
Dim CB: Set CB = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim Reg: Set Reg = CreateObject("VBScript.RegExp")
On Error GoTo TERMINATOR
Dim acApp As New Access.Application:
Dim MC, M, SubM, iM As Long
str = Selection.text  '数式を選択していることが前提
' マイナスに見える文字、上向きの三角(黒白)をマイナスに統一
str = RegReplaceExecute(str, "(" & ChrW("&H30FC") & "|" & ChrW("&H2011") & "|" & ChrW("&H2013") & "|" & ChrW("&H2014") & "|" & ChrW("&H2015") & "|" _
                                            & ChrW("&H30FC") & "|" & ChrW("&H2500") & "|" & ChrW("&H2501") & "\" & ChrW("&H3161") & "|" & ChrW("&H25B2") & "|" & ChrW("&H25B3") _
                                          & "|" & ChrW("&HFF70") & "|" & ChrW("&H4E00") & "|" & ChrW("&H2212") & "|" & ChrW("&H208B") & "|" & ChrW("8212") & ")", _
                                          ChrW("&H002D"))
str = StrConv(Selection.text, vbNarrow) '少なくともマイナス類は半角にする前に変換する

' 空白を除去
str = RegReplaceExecute(str, "[\u0020\u00A0\u2000\u3000]", "")
str = RegReplaceExecute(str, "[\t\r\v\n\f]", "") ' 改行等、スペース文字\s は \t\r\v\n\fと等価
str = Replace(str, vbCrLf, "", 1, -1, vbTextCompare)
str = RegReplaceExecute(str, "[=≒" & ChrW(8770) & ChrW(8771) & ChrW(8776) & ChrW(8316) & "]", "") ' 等号類の削除
str = RegReplaceExecute(str, "\D/\D", "") ' 円/㎡のような表記を削除。ただし㎡をアルファベットと数字で円/m2などと表している場合は除去できない
str = RegReplaceExecute(str, "[\\\$]", "") ' 通貨記号を削除

' Evaluateはコンマがあるとエラーになる
If UseXLWorkSheetFunction Then
    str = RegReplaceExecute(str, "(\,)(\d{3,})", "$2") 'コンマの次に3以上の数字が並ぶ場合のコンマを除去除去
Else
    str = RegReplaceExecute(str, "(\,)", "") ' 単純にコンマを除去するとRound(3.45,1)のような場合、
                                            ' Round(3.451)となる。ただしWordはコンマミスがあることも
                                            ' 考えられこちらを採用すべきとも考えられる。
                                            ' WorkSheetFunctionを使わないなら、これがシンプルでよい。
End If

str = RegReplaceExecute(str, "(\{|\[)", "(") '角カッコ、中括弧をただのカッコに(Evaluateはエラーになるため)
str = RegReplaceExecute(str, "(\}|\])", ")")

' かけるで変換される記号は2つある、高速化のためReplaceで変換
str = Replace(Replace(str, ChrW(10005), "*", 1, -1, vbTextCompare), ChrW(215), "*", 1, -1, vbTextCompare)
' ÷をスラッシュに置換
str = Replace(str, "÷", "/", 1, -1, vbTextCompare)

 ' StrConvによって半角にすると、CJK互換文字は?に、また、全角の句読点もよく似た別のものに変換される。このため、以下のコードは効かない
'str = RegReplaceExecute(str, "[\u3002]", ".") 'これが効かない
'str = RegReplaceExecute(str, "[。。.]", ".") 'これが効かない
'str = RegReplaceExecute(str, "[、]", ",") 'これが効かない
'str = RegReplaceExecute(str, "[\u3001\uFF0C]", ".") 'これが効かない
'str = RegReplaceExecute(str, "[\u30fb]", "*") 'これが効かない
'str = RegReplaceExecute(str, "[・]", "*") 'これが効かない U+30FB
'str = RegReplaceExecute(str, "[" & ChrW(13056) & "-" & ChrW(13311) & "]", "") ' CJK互換文字本来は有効だがStrConvによって消えている
'.Pattern = "[\u3300-\u33ff]"


' 百分率も評価されないため、式に変換
str = RegReplaceExecute(str, "[\u0025\uff05]", "*0.01") '百分率 こうした記号はエラーになるので、対応する係数に変換する
str = RegReplaceExecute(str, "[\u2030]", "*0.001") ' 千分率
str = RegReplaceExecute(str, "[\u2031]", "*0.0001") ' 万分率

str = RegReplaceExecute(str, "([0-9])([\uff61])([0-9])", "$1" & "." & "$3") ' 数字の間が。(U+3002)で小数点を打っている場合StrConvで半角になるとコードが変わる
str = RegReplaceExecute(str, "([0-9])([\uff64])([0-9]{3,})", "$1" & "," & "$3") ' 数字の間が、(u+3001)で小数点を打っている場合StrConvで半角になるとコードが変わる
str = RegReplaceExecute(str, "([0-9\)])([\uff65])([0-9\(])", "$1" & "*" & "$3")  '中黒(U+30FB)を乗算記号としている場合、 はStrconvによってU+FF65に変わっている

    If UseXLWorkSheetFunction Then
        ' Nzを視野に入れて、2字以上の英数字は削除しない。
        ' 関数とはとらえらない英語を削除つまり 英語が2字以上で(が続くもの以外
        str = RegReplaceExecute(str, "[^0-9/\.\+\-\*\^\(\)[A-z]{2,}]", "")
    Else
        str = RegReplaceExecute(str, "[^0-9/\.\+\-\*\^\(\)]", "")
         ' このパターンだと、Roundのような文字はすべて削除されてしまう。
         ' WorkSheetFunctionやVBAを使わなければ、こちらでもよい
    End If

str = RegReplaceExecute(str, "[ぁ-んァ-ヶ一-龠〃々〆〇。-゜]", "") ' 日本語を削除、。も削除
str = RegReplaceExecute(str, "\?", "")
str = RegReplaceExecute(str, "[^0-9a-zA-Z\.\,\/\(\)\<\>\%\*\-\+\^\|]", "") ' 12㎡のように、正規表現で取り切れないものを否定で取り除く
' 文字数チェック
If Len(str) >= 256 Then MsgBox "Evaluateは255文字までです", vbCritical, "エラー終了":  GoTo TERMINATOR
Debug.Print str
' ここからは ExcelのApplication.Evaluate、Application.ExecuteExcel4Macro("Evaluate(str)")
' AccessのEvalを使う方法がある。AccessはVBAの関数Cdateでも解釈する。ただしRoundは挙動が違う。Accessがインストールされていないと使えない。
' なぜか、-2147418113 要求された操作には管理者特権が必要です。というエラーを起こすなど問題があり、と考えられるため、通常はExcelが良い。
If Len(str) >= 256 Then MsgBox "Evaluateは255文字までです", vbCritical, "エラー終了":  GoTo TERMINATOR
If XLAndWorkSheetFuncOrAcEvalWithVBA Then
With CreateObject("Excel.Application")
buf = Format(.Evaluate(str), "#,##0.00") ' 表示形式で四捨五入
'buf = Format(.ExecuteExcel4Macro("EVALUATE(" & str & ")"), "#,##0.00")
End With
    If buf Like "*エラー*" Or LCase(buf) Like "*error*" Then
    With CreateObject("Access.Application")
    buf = Format(.Eval(str), "#,##0.00")
    End With
    End If
Else
With CreateObject("Access.Application")
buf = Format(.Eval(str), "#,##0.00")
End With
End If
With CB
.Clear
.SetText buf, 1
.PutInClipboard
End With
GoTo TERMINATOR
Exit Sub
TERMINATOR:
If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description: Err.Clear Else Debug.Print "OK"
If Not CB Is Nothing Then Set CB = Nothing
If Not Reg Is Nothing Then Set Reg = Nothing
Set acApp = Nothing
' Ctrl + V で貼り付け
End Sub

Function RegReplaceExecute(str As String, sPattern As String, Optional ReplaceChar = "") As String
' UDF RegReplaceExecute
' VBA
' 機能 正規表現のReplaceを適用する、置換文字を省略すると、削除になる
' 参照設定 不要
' 例 RegReplaceExecute("abcd12205aak2k5","\D") -> 1220525 \Dは数字以外の文字なので、文中の数字以外のアルファベットが消える。VBAのReplaceではできない
'     RegReplaceExecute("1,000,222,333","\D")  RegReplaceExecute("1,000,222,333","\,") -> 1000222333 コンマを削除
'     RegReplaceExecute("1,000,222,333","\,","'") -> 1'000'222'333 置換文字としてシングルクォーテーションを定めたので、コンマが置き換えられた
On Error GoTo TERMINATOR
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = False
.MultiLine = True
.Pattern = sPattern
RegReplaceExecute = .Replace(str, ReplaceChar)
End With
GoTo TERMINATOR
Exit Function
TERMINATOR:
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description: Err.Clear
RegReplaceExecute = ""
Exit Function
End If
End Function

特徴

これはそもそもCalcすら起動しないというところが特徴です。
あとExcelのEvaluateを使用しています。
これだと演算誤差の可能性はありますが、簡便な計算としては便利です。特にCalcと違い、コンマ付き数字をマウスでなければコピーしてWord、Excelに貼り付けることができないということはありません。上をみればキリがありませんが、かなり良くなったと思います
まだ成功していませんが、もし値まで入れたい場合にはBookMarkを作っておいてそこから値を入れるということになるでしょう。

正規表現メモ

大前提としてQiitaでは&hYen;

StrConv(String, VbNarrow)の影響

空白類似の文字をなぜかすべて変換や削除ができない。
そのほか、cjk互換文字U+3300-U+33FFや全角の。についてマッチすることはできるが、Replaceで削除したり、置換することができない。

Arrayに16進数をならべFor~Nextで回しても効く。効かなかったのはStrConvのせい。

Sub ArrayMatchtest()
  Dim Reg As New RegExp ' 参照設定あり
  Dim buf As String
  Dim spAr
  Dim i As Long
  Dim str As String
  str = Selection.text ' 2030U+8192U+8193という文字列を選択しています
  spAr = Split("8192,8193", ",")
  For i = LBound(spAr) To UBound(spAr)
    Reg.Pattern = "\u" & spAr(i)
    str = Reg.Replace(str, "")
  Next
  Debug.Print str '2030
End Sub

としても変換されない
変換されるのは並べる方式
"[\u00A0\u3000]"
このVBA正規表現では\uの後ろは16進数になり、必ず4桁で表示する必要がある(この16進数はUTF-16LE)
このときChrW()も使える。4桁の16進数で表せる範囲はUTF-16もUTF-8も同じ。
しかし、サロゲートペアになると異なる。
まず正規表現は\uは必ず4桁なので、この表記ではサロゲートペアを記述できない。
ここでChrW

つまり、サロゲートペアはこれでは入力できない。\u20BB7は使えていない。
ユニコードはChrwで並べてもよい、サロゲートペアもChrWを2つ重ねで通った。(通らなかったのは下位サロゲートが間違っていました)
最も再起動すると直るのかもしれない。

16進数→10進数の変換はVBA.Valの他にCDecでもできる

Sub VBA_HEX2DecTest()
Debug.Print VBA.Val("&HFFFFD800") ' -10240 
Debug.Print VBA.Val("&HD800") ' -10240
Debug.Print CDec("&HFFFFD800")  ' -10240 
Debug.Print CDec("&HD800") ' 55296
End Sub

VBA.VALはD800でもFFFFD800を計算しますが、CDECはしていません。
ただし、55296は65536から10240を引いた値で、でたらめな値ではありません。
どちらもHex()でD800に戻ります。
しかしUTF-8のサロゲートペアの定義に立ち返るとD800は`FFFFD800なのでCdecは簡便法だといえます。
とりあえずVBAにはHex2Decのような関数が準備されていないのではなく、名前が違うということなのでした。
なお、CDbl,Clngでも値は55296になります。

VBAのRegExでアンアン方式しか効かずユーユー方式は効かない

範囲を指定するとき
[ぁ-ん]というようにコードではなく、文字で並べる方法
[\u0000-\u00a0]のようにu+16進4桁で指定する方法
がある。
VBAにおいてはアンアン方式以外は効かないような気がする。
C#では名前付き範囲というのがあるが、VBAでは使えない。

Word用の正規表現分析ツールと方法

キーボード操作

サロゲートペアのつちよしを入力する。
20bb7と入力してALT+Xで変換できるが、
逆に吉の後ろでALT+Xを押すと今度は20BB7が表示される。
ここから、ALT+XでWordが示す文字符号はTF-8ではなく、UTF-16Eであることがわかる。
これではサロゲートペアは得られないが、この機能はマクロで記述できるので、AscWと組み合わせることで、UTF-8のサロゲートペアからU+20BB7を得ることができる。

VBA 入力
サロゲートペア以外
Sub insertChrwtest()
Selection.InsertAfter(ChrW(&HD842))
' &H10000より小さいユニコード文字は成功する
Selection.InsertAfter (ChrW(8192))
End Sub
サロゲートペアを出力

UTF-8のChrWを2つ使い、サロゲートペア文字を入力し、ToggleCharacterCodeでUTF-16のUnicodeスカラ値を取得します。
この方法でUTF-8しかわからなくてもサロゲートペアのU+16進数の値を取得できます。

Sub insertSarrogateWithChrWTest()
' For Word VBA
' 行末に移動
' UTF-8のChrWを使った書き方で、サロゲートペアを入力
' Selection.ToggleCharacterCodeでUTF-16のUnicodeスカラ値に変換
' 行末に移動し、スカラ値の分だけバック
'Selection.ToggleCharacterCodeで文字に変換
' UTF-8で指定したサロゲートペアを行末で出力
' UTF-8はChrWを2つ使い、UTF-16はToggleCharctgerCodeを使って出力する
' この方法で事実上UTF-8からUTF-16のユニコードスカラ値が求められる
Dim UTF16ScholorValue As String
Selection.EndKey Unit:=wdLine
Selection.EndKey Unit:=wdLine
Selection.InsertAfter (ChrW("&HD842") & ChrW("&HDFB7"))
Selection.MoveLeft Unit:=wdCharacter, Count:=0, Extend:=wdExtend
Selection.ToggleCharacterCode
Selection.MoveLeft Unit:=wdCharacter, Count:=0, Extend:=wdExtend
UTF16ScholorValue = Selection.Text
Selection.ToggleCharacterCode
Debug.Print "UTF16のU+16進数表記 U+" & UTF16ScholorValue
Selection.EndKey Unit:=wdLine
Selection.InsertAfter (UTF16ScholorValue)
Selection.EndKey Unit:=wdLine
Selection.MoveLeft Unit:=wdCharacter, Count:=Len(UTF16ScholorValue), Extend:=wdExtend
Selection.ToggleCharacterCode
End Sub

サロゲートペアは記録すると、キーボード操作で入力できた

Sub InsertSarrogate()
    Selection.TypeText Text:="20bb7"
    Selection.ToggleCharacterCode
End Sub

ただしこの方法は他のユニコード文字と連続して使うと、値が変わって解釈されるおそれがある。

VBA コード取得

選択した文字1字のコードを得る
ASCW で&HD842が取得された場合は、上位サロゲートを取得したとみなして、ChrW文字列を取得する

V1.1
  • WordのSelection.ToogleCharacterCodeを使いUTF-16のUnicodeスカラ値を取得する方法を思いつきました。
  • かつその機能を実装しました。
  • 次にサロゲートペアの判定基準としている上位サロゲートの修正、及び下位サロゲートの修正
AscWTest

```vbSub AscWTest()
Sub AscWTest()
' For Word VBA
' 一文字だけ選択した状態で起動すると、イミディエイトウィンドウに
' UTF-16、UTF-8の値か通常の変換結果を出力
' サロゲートの判定に
Dim b As String
Dim bb() As Byte
Dim Text As String
If Hex(AscW(Selection.Text)) >= Hex("&HD800") Then
Debug.Print "サロゲートペア"
bb = Selection.Text
Debug.Print "UTF-8: ChrW(" & "&H" & Hex(bb(1)) & Hex(bb(0)) & ") & " & "ChrW(" & "&H" & Hex(bb(3)) & Hex(bb(2)) & ")"
Selection.ToggleCharacterCode
Debug.Print "UTF-16: 書式:U+16進数(4桁から6桁): U+" & Selection.Text
Selection.ToggleCharacterCode ' この機能はWordだけ。ALT+Xを押したのと同じ効果がある。
Debug.Print "Asc:" & Asc(Selection.Text) & vbTab & "ascw:" & AscW(Selection.Text) & vbTab & "Hex(Ascw()): &H" & Format(Hex(AscW(Selection.Text)), "00000")
Else
Debug.Print "Asc:" & Asc(Selection.Text) & vbTab & "AscW:" & AscW(Selection.Text) & vbTab & "Hex(Ascw()): &H" & Format(Hex(AscW(Selection.Text)), "0000")
End If
End Sub
'''

VBA正規表現マッチテスト

選択した文字、文字列が、指定したパターンに一致するかを確認する。
一致するかをテストしてイミディエイトウィンドウに出力する。
VBAの正規表現ではサロゲートペア文字は\u20BB7ではなくUTF-8のChrWを2つ使う。
.Pattern = ChrW("&HD842") & ChrW("&HDFB7")
参考文献を見直して気がついがたが、この考え方を使うと
.Pattern = "\ud842\udfb7"このように書くと可能だった。\u20BB7ではだめだった。
MSでUnicodeといえばUTF-16というのが従来の常識だったのと、コレでは2字1字なのか、わからない。
実際に選択した範囲につちよしを入れるとマッチ(一致数)はつちよしの個数と一致する。倍ではない。
ただしMatchのLengthが2字になる。

Sub wdMatchTest()
' Word VBa
' DOCUMET上で選択した文字列の正規表現のテスト
Dim Reg: Set Reg = CreateObject("VBScript.RegExp")
Dim oMacthCollection, oMatch, i As Long
Dim buf
With Reg
.Global = True
.MultiLine = True
.IgnoreCase = False
'.Pattern = ChrW("&HD842") & ChrW("&HDFB7")
 '.Pattern = "[\ud800-\udbff][\udc00-\udfff]|[^\ud800-\udfff]"
 .Pattern = "\ud842\udfb7"
 .Pattern = "\u3161"
 .Pattern = "\B([a-zA-Z]*)(?!\()"
 buf = Selection.text
If .test(buf) Then
Set oMacthCollection = .Execute(buf)
Set oMatch = oMacthCollection.Item(0)
Debug.Print "Ptn:" & .Pattern & vbTab & "Match Count:" & oMacthCollection.Count & vbTab & "Match Value:" & oMatch.value
Debug.Print "Replace: " & .Replace(buf, "$1")
Else
Debug.Print "No Match"
End If
End With
End Sub

参考文献

VBA.Val関数
Unicode
ここではUTF-8からスカラ値を求めては行けないとされているが、Wordはトリッキーであるが、可能
文字コードに関する覚え書きと実験
Javaでは複雑。ExcelでもACCDBを使うのがセオリーだが、WordはAPIもADODBもExcelも使わないで変換できる。
文字コードのカオスな世界を整理してみた
全角チルダという問題がある。本記事では省略。誤入力するとは思えない。
Excel VBA Diaryさんの正規表現クイズ
現在のところサロゲートペアがChrwを2つ使うことを解説してるのはここしかない。
おそらく、Googleの検索が馴化していくと見つかると思われる。
[Excel] サロゲートペア対応が不完全……なんとかしてください、エクセルさん!😅
さり気なくサロゲートペアの正規表現が
.Pattern = "[\ud800-\udbff][\udc00-\udfff]|[^\ud800-\udfff]"
[JavaScript General] JavaScript でサロゲートペアを考慮して文字数をカウントする
上記の代用対全てを指す書き方はJavaScriptで定着しているようだ。ただしここでもLengthは2字

ハイフンと似た記号の区別が付きやすくしてほしい #6
このうちハングルの字母などは、正規表現でもReplaceでも効かない。サロゲートペアではない。入力も可能だが。とにかく
この点について、v5.0で英数字と演算子以外はすべて削除という正規表現でしのいでいる。
VBAで文字列から日本語を抽出する
正規表現で日本語を抽出する

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0