『文字列から数値と記号を抜き出して計算させる関数』（螢）
いつもお世話になっております。
今回は、文字列から数値と加減乗除の記号を抜き出して計算させる関数を作ったのですが、
繰り返し処理の多さなのか、使用するとExcelがクラッシュする頻度が上がるのでコードの書き方に不具合がある、ムダがあるという点についてご指摘をいただきたく投稿しています。
要点は、
文字列から数値と+-*/の記号を抜き出す
、は＋と同意義
加減乗除が出現する直前の数値から採用
（）は使用できるが、中身が文字列だけなら無視
＝と≒が出現したら以降は無視
数式の内容確認の為、CALCVは数式を文字列で表示し、
ANSはその数式の結果を任意の桁で四捨五入する。
といった感じです。
例えば、「月額2,000×12ヶ月」の結果は
CALCV→=2000*12
ANS→24000
となることを想定しています。
Function CALCV(Target As Range, Digit As Long)
Application.Volatile False
Dim buf As String, xTemp As String
Dim i As Long, VTemp As Long
' 初期化（不要な記号除去・全角→半角変換）
buf = StrConv(Replace(Target.Value, ",", ""), vbNarrow)
' 「＝」「≒」以降を削除
Dim eqPos As Integer
eqPos = InStr(buf, "=")
If eqPos = 0 Then eqPos = InStr(buf, "≒")
If eqPos > 0 Then buf = Left(buf, eqPos - 1)
' 文字を演算子に置換
buf = Replace(buf, "､", "+")
buf = Replace(buf, "△", "-")
buf = Replace(buf, "×", "*")
buf = Replace(buf, "÷", "/")
'余分な空白を削除
buf = WorksheetFunction.Trim(buf)
buf = Trim(buf)
If Left(buf, 1) = "=" Then buf = Right(buf, Len(buf) - 1)
Dim result As String
result = buf
i = 1
Do Until i > Len(buf)
xTemp = Mid(buf, i, 1)
If xTemp Like "[!0-9]" Then
If xTemp = "+" Or xTemp = "-" Or xTemp = "*" Or xTemp = "/" Or xTemp = "(" Or xTemp = ")" Then
If VTemp <> 2 Then VTemp = 2
Else
If VTemp = 1 Then VTemp = 0
If xTemp = "%" Then
If result <> Replace(result, "%", "\_\") Then result = Replace(result, "%", "\_\")
ElseIf xTemp = "." Then
If result <> Replace(result, ".", "\__\") Then result = Replace(result, ".", "\__\")
If VTemp <> 1 Then VTemp = 1
ElseIf xTemp <> " " Then
If result <> Replace(result, xTemp, "") Then result = Replace(result, xTemp, "")
End If
End If
Else
If VTemp = 0 And i > 1 Then
If Mid(buf, i - 1, 1) = "+" Then
Else
buf = Left(buf, i - 1) & "++" & Right(buf, Len(buf) - Len(Left(buf, i - 1)))
result = buf
i = i + 1
VTemp = 2
End If
Else
VTemp = 1
End If
End If
i = i + 1
Loop
If Left(result, 2) = "++" Then result = Right(result, Len(result) - 2)
If result <> Replace(result, "()", "") Then result = Replace(result, "()", "")
result = Replace(Replace(result, "\_\", "%"), "\__\", ".")
' 末尾に演算子がある場合削除
Do While Right(result, 1) Like "[+*/-]"
result = Left(result, Len(result) - 1)
Loop
If Left(result, 2) = "++" Then result = Right(result, Len(result) - 2)
If InStr(result, "+") > 0 And InStr(result, "+") < InStr(result, "++") Or _
InStr(result, "-") > 0 And InStr(result, "-") < InStr(result, "++") Or _
InStr(result, "*") > 0 And InStr(result, "*") < InStr(result, "++") Or _
InStr(result, "/") > 0 And InStr(result, "/") < InStr(result, "++") Then
result = Replace(result, "++", "+")
Else
result = Right(result, Len(result) - InStrRev(result, "++"))
End If
result = Replace(result, " ", "")
Do Until InStr(result, "**") = 0 And InStr(result, "//") = 0
If result <> Replace(result, "**", "*") Then result = Replace(result, "**", "*")
If result <> Replace(result, "//", "/") Then result = Replace(result, "//", "/")
Loop
If Left(result, 1) = "+" Then result = Right(result, Len(result) - 1)
If Left(result, 2) = "-+" Then result = "-" & Right(result, Len(result) - 2)
Application.EnableEvents = False
'If result = "" Or IsError(result) = True Then
' CALCV = "数値が抽出できません"
'Else
CALCV = "=" & Trim(StrConv(result, vbNarrow))
'End If
Application.EnableEvents = True
End Function
Function ANS(Target As Range, Digit As Long)
Application.Volatile False
Dim buf As String
Dim result As String
buf = CALCV(Target, Digit)
If TypeName(Evaluate(buf)) = "Error" Then
buf = "数値と認識できません"
Else
buf = Evaluate(buf)
End If
Application.EnableEvents = False
If IsNumeric(buf) = False Then
ANS = buf
Else
ANS = WorksheetFunction.Round(buf + 0, Digit)
End If
Application.EnableEvents = True
End Function
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
どういうケースでエラーが発生するのでしょうか？ 事象が再現するようなデータを提供できませんか？ ちなみに、このコードは質問者さんが作成されたものと考えてよろしいのですね？
>加減乗除が出現する直前の数値から採用 ということは、複数の計算式を含んでいても、最後のものだけを相手にすれば よいのですか？ そもそもどのような目的で作成されたものなのでしょうか。 それもお聞かせいただくとありがたく思います。
（xyz） 2025/03/31(月) 22:51:53
これだとだめですか?
Function CALCV(Str As String)
Dim s As String
Dim v
s = StrConv(Str, vbNarrow)
For Each v In Array(Array("×", "*"), Array("÷", "/"), Array(",", ""))
s = Replace(s, v(0), v(1))
Next v
With CreateObject("VBScript.RegExp")
.Pattern = "[\d\.]+[\+\-\*\/][\d\.]+"
CALCV = "=" & .Execute(s)(0)
End With
End Function
Function ANS(Str As String)
ANS = Evaluate(CALCV(Str))
End Function
（んなっと） 2025/04/01(火) 06:58:07
(-2,000)×5 や 500×(10-2)などにも対応。
Function CALCV(Str As String) As String
Dim s As String
Dim v
s = StrConv(Str, vbNarrow)
For Each v In Array(Array("×", "*"), Array("÷", "/"), Array(",", ""), _
Array("､", "+"), Array("△", "-"))
s = Replace(s, v(0), v(1))
Next v
With CreateObject("VBScript.RegExp")
.Pattern = "[\d\.\+\-\*\/\(\)]+"
.Global = True
For Each v In .Execute(s)
.Pattern = "[\d\.]+"
If .Execute(v).Count > 1 Then
CALCV = "=" & v
Exit For
End If
Next v
End With
End Function
Function ANS(Str As String)
Dim n
n = Evaluate(CALCV(Str))
If IsNumeric(n) Then
ANS = n
Else
ANS = ""
End If
End Function
（んなっと） 2025/04/01(火) 10:41:36
str = "(月額2,000×12ヶ月＋10,000/2)、月額3,000円×12ヶ月" のとき (2000*12+10000/2)+3000*12 を計算して 65000 でよいなら、以下でどうでしょうか。（んなっとさんのコードをお借りしました。）
Sub test()
Dim str As String
str = "(月額2,000×12ヶ月＋10,000/2)、月額3,000円×12ヶ月"
Debug.Print ANS(str)
End Sub
Function CALCV(str As String) As String
Dim s As String
Dim v
s = StrConv(str, vbNarrow)
For Each v In Array(Array("×", "*"), Array("÷", "/"), Array(",", ""), _
Array("､", "+"), Array("△", "-"))
s = Replace(s, v(0), v(1))
Next v
With CreateObject("VBScript.RegExp")
.Pattern = "[^\d\.\+\-\*\/\(\)]+"
.Global = True
s = .Replace(s, "")
CALCV = "=" & s
End With
End Function
Function ANS(str As String)
Dim n
n = Evaluate(CALCV(str))
If IsNumeric(n) Then
ANS = n
Else
ANS = ""
End If
End Function
なお、すべての機能を満たしているとは思っていません。
>加減乗除が出現する直前の数値から採用 この意味がわかりませんでした。
（xyz） 2025/04/01(火) 18:41:10
なお、角かっこのなかの特殊文字は基本的にエスケープ不要だったかもしれません。（ハイフンや\そのもの以外） （xyz） 2025/04/01(火) 18:48:05
なるほど、xyzさんの解釈がよさそうですね。 全体としてはひとまとまりの数式の意味を持ち、単位以外の余計な情報は少ない。 （んなっと） 2025/04/01(火) 18:56:57
後出しで変則データが出てくると思うけど、とりあえず
(月額2,000×12ヶ月、10,000/2)、月額3,000円×12ヶ月 →(2000*12+10000/2)+3000*12=65000 月額2,000×12ヶ月=月額2,000×12ヶ月 →2000*12=24000 月額2,000÷12ヶ月、5000 →2000/12+5000=5166.66666666667 123x(1+2）-50 →123*(1+2)-50=319 〇；△(第25期)月額12,124+(1＋2)*0.5%△△ →12124+(1+2)*0.5%=12124.015 〇；△(春季)月額12,124、(1＋2)*0.5%△△ →12124+(1+2)*0.5%=12124.015
Function MyEval(s$)
Dim e
s = StrConv(s, 8)
For Each e In Array([{"、","+"}], [{"△","-"}], [{"×", "*"}], [{"x","*"}], [{"÷", "/"}])
s = Replace(s, e(1), e(2), , , 1)
Next
With CreateObject("VBScript.RegExp")
.Pattern = "^[^＝=≒]+"
s = .Execute(s)(0)
.Global = True
.Pattern = "[^\d.%xX()*/+−^-]"
s = .Replace(s, "")
.Pattern = "[.%xX*/+−^-]+([.%xX*/+−^-])"
s = .Replace(s, "$1")
.Pattern = "[.xX*/+−^-]+$"
s = .Replace(s, "")
.Pattern = "[+*/^-]?\(\d*\)"
s = .Replace(s, "")
MyEval = Array("=" & s, Evaluate(s))
End With
End Function
（jindon） 2025/04/01(火) 19:35:03
どういうケースでエラーが発生するのでしょうか？ 事象が再現するようなデータを提供できませんか？ 明らかなエラーが発生しているかどうかがわかっていないのが現状です。
ただ、この関数を使用するとExcelが突然強制終了してしまう現象が起きているのは事実です。
もしかして、このコードが想像以上にPCに負荷をかけているのではないか、と思った次第あります。
ちなみに、このコードは質問者さんが作成されたものと考えてよろしいのですね？ はい、これは本で調べたりwebで情報を集めて自分なりに作成したものです。
会社で使用しているものですが、個人的に作成しているので公開に問題はありません。
>加減乗除が出現する直前の数値から採用 ということは、複数の計算式を含んでいても、最後のものだけを相手にすれば よいのですか？ 例えば、実際の事例として、
「バージョン3 月額10,000円×12ヶ月 使用料」という文字列に対して使用した場合、
加減乗除が出現する → 10,000円×←ここで出現なので
その直前の10,000が数式の開始となります。
数式は、 =10000*12 で結果は120000 となります。
バージョン3 に3という数字が含まれていますが、その後10,000が出てくるまで+-*/（または、）が
存在しないので3は数値として扱わないということでした。
そもそもどのような目的で作成されたものなのでしょうか。 それもお聞かせいただくとありがたく思います。 会社のシステムで採用しているものではありますが、差し障りの無い範囲で説明しますと、
会計伝票を作成する（最終的には指定のフォーマットに印刷）ものですが、
決められたフォーマットの列が、日付、取引先、金額、摘要の4列しか存在しておらず、
そのフォーマットに従ってExcel入力をして、そこからCSV出力して会計ソフトに読み込みを行い、
また入力したExcelは会計伝票として印刷される仕組みです。
CSV出力のあたりの仕組みは既に完成してはいるのですが、
金額と摘要のあたりで整合性の取れない入力が起こり得るため、
金額を入力→摘要を入力 ではなく、
摘要に計算内訳が存在する場合は、摘要を入力することで金額を自動計算させ
その金額が適正かどうかを判定しやすくすることが目的でした。
会社側からはどのような形でも良いのでエラーを減らすよう指示がされたので
VBAを使ってなんとかならないかと取り組んでいたところです。
作成した時点ではうまく稼働していたのですが、次第に強制再起動が発生する報告があがってきて
どうも発生し始めた時期とこの関数が採用された時期が近いことから、原因と考えられる、ということです。
入力例として社内で提示している文字列の一覧を貼り付けてみます。
入力文字列 CALCV ANS
2,000円×2ヶ月 =2000*2 4000
2,000円×2ヶ月、3,000円×10ヶ月 =2000*2+3000*10 34000
+2000円×12ヶ月 =2000*12 24000
10,000円×12ヶ月＝120,000円 =10000*12 120000
月額2,000円×12ヶ月 =2000*12 24000
バージョン22月額2,000円×12ヶ月 =2000*12 24000
12000×10% =12000*10% 1200
△2000×3人 =-2000*3 -6000
2.5杯×10人分 =2.5*10 25
月額2,000円×（10＋2）ヶ月 =2000*(10+2) 24000
10,000円×3人（来月） =10000*3 30000
10000＋−2000 =10000+-2000 8000
10000−＋2000 =10000-+2000 8000
10000÷÷2000 =10000/2000 5
10000××2000 =10000*2000 20000000
10000÷×2000 =10000/*2000 数値と認識できません
バージョン3月額10,000円×12ヶ月使用料 =10000*12 120000
xyzさんが提示してくださった文字列の結果は、やはり65000で間違いないです。
(月額2,000×12ヶ月＋10,000/2)、月額3,000円×12ヶ月 =(2000*12+10000/2)+3000*12 65000
とりあえず、お返事を書きましたが、これから残務を片付けてまたご提示いただきましたコードを試してみます！
（螢） 2025/04/01(火) 19:47:40
jindonさんもすみません、仕事終わりましたら確認します！
（螢） 2025/04/01(火) 20:04:08
とりあえず 2025/04/01(火) 19:35:03 の私のコードは修正しました。 （jindon） 2025/04/01(火) 20:17:39
螢さんが、提示された例については同じ結果となりました。 この手の質問は、最初の質問で考えられるすべての例を提示するようにしてください。 後出しで追加されるパターンについては対応しかねますので、ご了承ください。
[B2] =EvalEx(A2,0) 下にコピー
__A__________________________________ __B____________ __C_________________
1 入力文字列 式 答え
2 2,000円×2ヶ月 =2000*2 4000
3 2,000円×2ヶ月、3,000円×10ヶ月 =2000*2+3000*10 34000
4 +2000円×12ヶ月 =2000*12 24000
5 10,000円×12ヶ月＝120,000円 =10000*12 120000
6 月額2,000円×12ヶ月 =2000*12 24000
7 バージョン22月額2,000円×12ヶ月 =2000*12 24000
8 12000×10% =12000*10% 1200
9 △2000×3人 =-2000*3 -6000
10 2.5杯×10人分 =2.5*10 25
11 月額2,000円×（10＋2）ヶ月 =2000*(10+2) 24000
12 10,000円×3人（来月） =10000*3 30000
13 10000＋−2000 =10000+-2000 8000
14 10000−＋2000 =10000-+2000 8000
15 10000÷÷2000 =10000/2000 5
16 10000××2000 =10000*2000 20000000
17 10000÷×2000 =10000/*2000 数値と認識できません
18 バージョン3月額10,000円×12ヶ月使用料 =10000*12 120000
19 当初 200,000円 × 7/24 ≒ 58,333円 =200000*7/24 58333
20 当期分 200,000円 × 7/20 ＝ 70,000円 =200000*7/20 70000
Function EvalEx(inputString$, Optional digit)
Dim s$, ret, v, pos&, mc
'半角化
s = StrConv(inputString, vbNarrow)
'指定文字を演算子に置換、桁区切り、空白削除
For Each v In Array(Array("､", "+"), Array("△", "-"), Array("×", "*"), Array("÷", "/"), Array(",", ""), Array(" ", ""))
s = Replace(s, v(0), v(1))
Next
Static RegEx As Object
If RegEx Is Nothing Then Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
'演算開始位置より=≒までを取得
.Global = False
.Pattern = "[+-]?\d+(?:\.\d+)?(?:\D+)?[-+*/]\(?\d+[^=≒]*"
Set mc = .Execute(s)
If mc.Count = 1 Then
s = mc(0)
'先頭の+符号と演算部以外を削除
.Global = True
.Pattern = "^\+|[^-+*/%0-9.()]"
s = .Replace(s, "")
'10,000円×3人（来月）とか10,000円×3人（5月）のような無効なカッコ部分を削除
.Pattern = "(\d)\(.*\)"
s = .Replace(s, "$1")
'**等の連続演算子を削除
.Pattern = "([-+*/])\1+"
s = "=" & .Replace(s, "$1")
Dim eval
eval = Evaluate(s)
If Not IsNumeric(eval) Then
ret = Array(s, "数値と認識できません")
Else
If IsMissing(digit) Then
ret = Array(s, eval)
Else
ret = Array(s, WorksheetFunction.Round(eval, digit))
End If
End If
Else
ret = Array(CVErr(xlErrValue), CVErr(xlErrValue))
End If
End With
EvalEx = ret
End Function
（まる2021） 2025/04/02(水) 02:14:57
先頭の+削除が抜けていました。追加。
余計な文字削除...xyzさんのコードをお借りしました
**等の連続演算子を1つにする...まる2021さんのコードをお借りしました
Function CALCV(Str As String) As String
Dim s As String
Dim v
Dim i As Long
s = StrConv(Str, vbNarrow)
For Each v In Array(Array("×", "*"), Array("÷", "/"), Array(",", ""), _
Array("､", "+"), Array("△", "-"), Array(" ", ""))
s = Replace(s, v(0), v(1))
Next v
With CreateObject("VBScript.RegExp")
.Pattern = "[\d.()%+\-]+[^\d=]*[+\-*/][^=]*" '最初の数値+-*/から=の手前まで抽出
If .Test(s) Then
s = .Execute(s)(0)
.Pattern = "[^\d.+\-*/()%]+" '余計な文字削除
.Global = True
s = .Replace(s, "")
.Pattern = "([^\d+\-)]|^)\+|\(\)|(\D|^)\)|\((?=[^\d\-]|$)" '先頭の+,末尾の(など削除
s = .Replace(s, "$1$2")
.Pattern = "([-+*/])\1+" '**等の連続演算子を1つにする
s = .Replace(s, "$1")
CALCV = "=" & s
End If
End With
End Function
（んなっと） 2025/04/02(水) 07:30:22
10,000円×3人（5月）は、さすがにあり得るので、コード修正しておきました。 又、んなっとさんのを見て、演算開始位置より=≒までを取得を修正しました。 んなっとさん> ≒で終わる条件がないような.... （まる2021） 2025/04/02(水) 10:23:07
ありがとうございます。勉強になります。
Function CALCV(Str As String) As String
Dim s As String
Dim v
Dim i As Long
s = StrConv(Str, vbNarrow)
For Each v In Array(Array("×", "*"), Array("÷", "/"), Array(",", ""), _
Array("､", "+"), Array("△", "-"), Array(" ", ""))
s = Replace(s, v(0), v(1))
Next v
With CreateObject("VBScript.RegExp")
.Pattern = "[\d.()%+\-]+[^\d=]*[+\-*/][^=≒]*" '最初の数値+-*/から=の手前まで抽出
If .Test(s) Then
s = .Execute(s)(0)
.Pattern = "[^\d.+\-*/()%]+" '余計な文字削除
.Global = True
s = .Replace(s, "")
.Pattern = "([^\d+\-)]|^)\+|([^-+*/(])\(.*?\)|(\D|^)\)|\((?=[^\d\-]|$)" '先頭の+,末尾の(など削除
s = .Replace(s, "$1$2$3")
.Pattern = "([-+*/])\1+" '**等の連続演算子を1つにする
s = .Replace(s, "$1")
CALCV = "=" & s
End If
End With
End Function
（んなっと） 2025/04/02(水) 12:14:45
2025/04/01(火) 19:47:40に質問者さんからもらったコメントにつき、感想を書きます。回答ではありません。
提示されたコードを何回かテスト実行しましたが、特段に異常事象は起きませんでした。 コードは文字列処理ですので、複雑さに負けてクラッシュするということはちょっと考えられません。 テキスト処理は十分に枯れたものですので、なんらかのエラーを出すはずで、 クラッシュするという話は質問掲示板でも滅多に見ません。 示されていないそれ以外のところで発生している可能性はありませんか？ ・そもそもそのFunctionプロシージャはなんらかのイベントプロシージャで呼んでいるんですか？ そのなかで On Error Resume Nextを使っているとかの関係はありませんか？ ・CSV保存する処理とか、別のイベントプロシージャとの関係とか、 ・Excelアプリケーションそのものになんらかの障害が発生しているとか。
正規表現に慣れてしまっている側からすると、ちょっと読みにくいコードではあります。
例えば、
If xTemp = "%" Then
If result <> Replace(result, "%", "\_\") Then result = Replace(result, "%", "\_\")
といったコードは意図がわかりません。
"%"が存在するなら、result <> Replace(result, "%", "\_\")となるのは自明なので、
なぜ条件判定して置換を二回実行させるのでしょうか。
つぶさに読んだわけではないので恐縮です。部分的な感想です。
（xyz） 2025/04/02(水) 15:15:36
xyzさんからいただきました感想は取り急ぎ回答できそうでしたので記載してみます。
コードは文字列処理ですので、複雑さに負けてクラッシュするということはちょっと考えられません。 そうでしたか。。。そういったこともわからず、他に原因があるのかもしれません。
示されていないそれ以外のところで発生している可能性はありませんか？ 今回は数式に問題があると当たりをつけてご質問させていただいていたものですから、
実際にはもう少し挙動がありますが割愛させていただいていました。
例えば、列によっては文字数の上限が決められていることから、
上限を超過したらセルは色付けがされるなどの動きは入力ごとにチェックが行われます。
しかしこれまでここに関してのクラッシュ報告が無かったため、関連なしと判断してしまっていました。
・そもそもそのFunctionプロシージャはなんらかのイベントプロシージャで呼んでいるんですか？ これは、手作業で数式を入力する方法と、
マクロのショートカットでSelection.Formula = "=ANS(RC[1],0)"
を入力できるようにしてあります。
金額列の一つ右が摘要列の為、初期に一つ右のセルを指定するようにしています。
そのなかで On Error Resume Nextを使っているとかの関係はありませんか？ これは処理が延々終わらなくExcelが落ちる原因になりやすいということでしょうか。
CSV出力や、同フォーマットの他ファイルから読み込む際には使用していますね。。。
正規表現に慣れてしまっている側からすると、ちょっと読みにくいコードではあります。 正規表現というものは、少し勉強してみたのですがお恥ずかしながら理解できず採用を見送りました。
If result <> Replace(result, "%", "\_\") Then result = Replace(result, "%", "\_\") これにつきましては、本当にお恥ずかしながら、VBAの書き方をよくわかっていない素人が
色々考えた結果できあがったものでした。
実は、当初は文字列処理の考え方もよくわかっておらず、
今回のような「（1)あるセルに入力された文字列」から「（2)別の文字列を作り出す」といった処理の場合に、(1)を元に、一文字ずつ取り出してその都度(2)のセルに直接書き込んでいく方法を採用していました。
セルを直接編集していくと、その都度Worksheetのchange（前述のセルに色を塗るなど）が起動することに最初は気づいておらず、
動作が遅いな、と検証していく過程でようやく気づき、
セルの編集の前に、編集前と置き換え後に変化が無いかを確認してから上書きしていくような方法を取っていました。
それが、セルに書き込む前に文字列処理をして最終的なものをセルに書き込むという方法に至るまで試行錯誤していたものですから、その名残です。
最終的なものを書き込む前にApplication.EnableEvents = Falseがあるのもその名残です。
全く、無知でお恥ずかしい限りです。
（螢） 2025/04/02(水) 20:45:17
＞ご回答を引用しようとおもって「＞」をつけてみたのですが、 ＞うまく表現されておらず、読みにくくて申し訳ありません。
半角スペースを頭に入れると改行されないです。ぜひ活用してください。
（ななし） 2025/04/02(水) 22:12:57
ご返事いただきありがとうございました。手がかりには見つけられませんでした。 On Error Resume Nextとしているので、ユーザーには知らされないものの深刻な事象が起きているのかも、 という素人発想でした。 なにか、こういうケースでクラッシュしたという例があると分かりやすいですね。
ところで、 >正規表現というものは、少し勉強してみたのですがお恥ずかしながら理解できず採用を見送りました。 とのことですが、皆さんが回答されているものは、すべて正規表現を使われているものですが、 大丈夫なんですか？
（xyz） 2025/04/02(水) 22:47:28
>半角スペースを頭に入れると改行されないです。ぜひ活用してください。 ななしさん、ご教授ありがとうございます。
>なにか、こういうケースでクラッシュしたという例があると分かりやすいですね。 本当に具体例が提示できず申し訳ないのです。私も自分で体験していますが、 関数を入力する→次のセルをクリックする→クラッシュ という短時間に発生することもあれば、 数分操作したところで前触れなくクラッシュ という時間を開けることもありました。
自動的にExcelが最終保存時の状態で再起動しますが、
保存→関数入力→即クラッシュ
の流れの時、再起動後に全く同じように
保存→関数入力 としてもクラッシュしないこともざらにあるのです。
>皆さんが回答されているものは、すべて正規表現を使われているものですが、 これもそうなのですね。F8で1行ずつ確認しながら進んでいるのですが、 何が起きているのか今のところ理解できていません。 採用させていただくにしても、理解できないまま使用するのも後ろめたいのでもう少し勉強してみます。 （螢） 2025/04/02(水) 23:24:25
Application.Volatile Falseと言うコードがありますが、これをTrueにして運用することはあるんでしょうか。 興味本位の質問ですみません。なぜわざわざ入れているのでしょうか。
他のPCでも同じ事象が発生するのでしょうか。 そのPCだけであれば、そのPCの環境に障害がある可能性はないでしょうか。 アプリケーションを再インストールも視野に入れて検討されてはいかがですか。
ChangeやSelectChangeなどのイベントプロシージャなどが動作しているなら、それが影響していないでしょうか。 よもやとは思いますが、そのなかで無限連鎖が発生している可能性はないでしょうか。 制御が返ってくるのに時間を要するときもある、と言う話は、そうしたことを想像させます。 ただ、たいていはスタック領域不足エラーとかなるだけで、クラッシュすることはないような気もしますが。
（xyz） 2025/04/03(木) 10:22:01
螢さん、 正規表現を使用しないコードです。
=myEval(A1)
Function myEval(s$)
Dim e, x, i&, flg As Boolean
If s = "" Then myEval = "": Exit Function
s = StrConv(s, 8): flg = False
For Each e In Array([{"、","+"}], [{"△","-"}], [{"×", "*"}], [{"x","*"}], _
[{"=","@@@"}], [{"≒","@@@"}], [{"÷", "/"}], [{",",""}])
s = Replace(s, e(1), e(2), , , 1)
Next
s = Split(s, "@@@")(0)
For i = 1 To Len(s)
If (Not Mid$(s, i, 1) Like "[0-9/^+()%.-]") * (Not Mid$(s, i, 1) Like "[*]") Then Mid$(s, i, 1) = " "
Next
s = Application.Trim(s)
If Not IsError(Evaluate(s)) Then
s = "=" & Replace(s, " ", "")
myEval = Array(s, Evaluate(s)): Exit Function
End If
x = Split(s): s = ""
For i = 0 To UBound(x)
x(i) = Replace(Replace(x(i), "**", "*"), "//", "/")
If IsNumeric(x(i)) Then
s = x(i)
ElseIf (x(i) Like "*[+/-]*") + (x(i) Like "*[*]*") Then
s = s & x(i)
End If
If x(i) Like "[()]" Then x(i) = ""
If (x(i) Like "*/[*]*") + (x(i) Like "*[*]/*") Then flg = True
Next
myEval = Array("=" & s, IIf(flg, "数値と認識できません", Evaluate(s)))
End Function
（jindon） 2025/04/03(木) 13:55:25 (不要部分削除 14:03)
>Application.Volatile Falseと言うコードがありますが、 >これをTrueにして運用することはあるんでしょうか。 >興味本位の質問ですみません。なぜわざわざ入れているのでしょうか。 すみません、はっきり理解していないのですが、これがFalseになっていないとシート内のどこを編集しても 関数を繰り返し計算してしまう、と思って入れたことがあります。実際のことろ、挙動を検証しても 繰り返し計算するときとしない時の違いがわかりませんでしたが、 Falseでもtrueでもコードを書き換えた直後以外は繰り返し計算「しない」と感じていました。 繰り返し計算しないことが負荷の低減になるのかと思ってそのまま残していました。
>他のPCでも同じ事象が発生するのでしょうか。 >そのPCだけであれば、そのPCの環境に障害がある可能性はないでしょうか。 >アプリケーションを再インストールも視野に入れて検討されてはいかがですか。 はい、使用しているほとんどのPCで同じ現象が発生しています。 発生していない人は、使用時間が10分そこらで短時間使用者のみです。 かくいう私も昨夜も使用していましたが、（締切が迫っているので改変ができず ご提示いただいたコード実装前をそのまま使用しています。）数度発生しました。 発生する時の挙動を注意して観察していましたが、セルの編集中などではなく、 ホイールでスクロールしている最中や、あるセルをクリックしようとした際に 実際に画面が動いたりそのセルが選択されることはなく、なんの反応もしなくなり、 数秒後にクラッシュ→勝手に再起動 です。
>ChangeやSelectChangeなどのイベントプロシージャなどが動作しているなら、それが影響していないでしょうか。よもやとは思いますが、そのなかで無限連鎖が発生している可能性はないでしょうか。 使用者が複数人入れ替わり立ち替わりで操作するため、予期せぬエラーが発生するたびにコードを 修正してきたことでエラー回避の為のコードはそれなりに備えてあり、無限連鎖は発生していないと思っています。素人が手を加え続けてまるで違法建築物のような有り様にはなっていますが、 ここ数年はエラー自体が発生していないくらいにはなっていました。 現に、今回の関数を実装するまではクラッシュの報告が無かった状態でしたので。。。
>スタック領域不足エラーとかなるだけで、 このエラーは導入初期の頃にあった記憶があります。 あまりにループの回数が多かったなどを解消したところ、発生しなくなった経緯もあり、 今回導入した関数も負荷が異常にかかっている箇所があるのでは、と考えた次第でありました。
jindonさん、ありがとうございます。
今日もまだ仕事が終わらず、休憩時間で返信を書いていますが、週末くらいにじっくり見てみますm(_ _)m
（螢） 2025/04/04(金) 00:13:55
ただ、ご指摘いただいたとおり、クラッシュの直接要因では無い可能性が高そうでしたので、
その他のコードを見直す方向でいきたいと思います。
今回、新たに正規表現の使い方を学べたことが他に活かせそうです。
ありがとうございました。
複雑な文字列例（カッコが伴い、文字列演算子を多数含むようなものなど）
(月額2,000×12ヶ月)
（定価12000×10%）、1000＋2000
〇；△(第25期)月額12,124+(1＋2)*0.5%△△
120,000円÷10,000円/月＝12ヶ月
Function CALCV(Target As String, Dijit As Long) As String
Dim s As String
Dim v As Variant
s = StrConv(Target, vbNarrow) '全角→半角変換
For Each v In Array(Array("×", "*"), Array("÷", "/"), Array(",", ""), _
Array("､", "+"), Array("△", "-")) '記号置換（×→*、÷→/ など）
s = Replace(s, v(0), v(1))
Next v
With CreateObject("VBScript.RegExp")
.Pattern = "[\d.()%+\-]+[^\d=]*[+\-*/][^=≒]*" '式の抽出（最初の演算子が出てくる部分から「＝」「≒」の前まで）
If .Test(s) Then
s = .Execute(s)(0)
.Pattern = "[^\d.+\-*/()%]+" '数値・演算子・括弧以外を削除
.Global = True
s = .Replace(s, "")
.Pattern = "([^\d+\-)]|^)\+|([^-+*/(])\(.*?\)|([^\d%]|^)\)|\((?=[^\d\-]|$)" '先頭の+や孤立した(など削除
s = .Replace(s, "$1$2$3")
s = Replace(s, "/", "@@@") '「/」を一旦仮置き（あとで必要な分だけ復元）
.Pattern = "@@@(?=[\d(+\-*/])"
.Global = True
s = .Replace(s, "/")
.Pattern = "@@@" '不要な @@@ は削除（単位区切りの / の削除）
s = .Replace(s, "")
.Pattern = "([-+*/])\1+" '連続演算子（**など）を1つに
s = .Replace(s, "$1")
.Pattern = "[.xX*/+−^-]+$" '式の末尾に演算子があれば削除
s = .Replace(s, "")
If Left(StrConv(Target, vbNarrow), 1) = "(" And _
Left(s, 1) <> "(" Then s = "(" + s '元が ( で始まっていた場合は補完
CALCV = "=" & s
Else
CALCV = Target
End If
End With
End Function
（螢） 2025/04/05(土) 16:58:01
VBA での正規表現は将来的に使用できなくなります。
正規表現は大変便利な機能なので私自身も多用してきましたが、今正規表現を使用した全てのコードを書き換えています。
私が最後に投稿したコードは上記を踏まえたものです。 （jindon） 2025/04/05(土) 18:00:22
いずれにしても解決済みのようですが、関連事項のメモを書いておきます。 ■ Application.Volatile False についての補足です。これはその関数を非揮発性にする効果があります。
その関数を揮発性関数(OffsetやIndirect等）とともに使用していなければ、特に問題は発生しません。 こういう場合は、何も宣言しないのが普通だと思います。
ANS関数を揮発性関数とともに使用する場合に、この設定をすると、 ・無関係のセルに変化が生じて、それに伴って再計算されることはなくなるものの、 ・関数を入れたセルを更新（式を再入力（F2での修正入力含む））しない限り、 参照している引数の値が変わっても値は変化しないので注意が必要です。
■ いずれにせよ、通常の文字列処理の範囲でエラーメッセージもなくクラッシュすることは普通は考えられません。 提示されていないコードや実際の利用状況をなど、全体を調べない限り原因特定は難しいでしょう。
もし、使っている複数のPCでクラッシュがたびたび発生するということであれば、 これは大変な事であって、質問掲示板に相談しているような場合ではないと思います。 上司と相談して事態改善に動かないといけないのではないでしょうか。 きちんとお金を掛けて調査・改善すべきだと思います。（部分的な情報では調べることになりません）
（xyz） 2025/04/07(月) 14:50:17
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.