![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
No.1ベストアンサー
- 回答日時:
http://oshiete.goo.ne.jp/qa/10287532.html
で作ったものを修正しました。カンマが入るとエラーになるからです。
String2Number関数というユーザー定義関数です。
これは、擬似的なNumberString関数の逆関数です。
NUMBERSTRING(セル,1) に対応もします。
結果は以下のようになります。それ以外の方法は知りません。
1400万 14,000,000
50百万円 50,000,000
24億5,639万5,000 2,456,395,000
800億96百万 80,096,000,000
4.4億 440,000,000
18億34万7,400 1,800,347,400
2兆2,562億7,500万 2,256,275,000,000
12億5,500万 1,255,000,000
22億3,766万 2,237,660,000
181億3,000万 18,130,000,000
String2Number関数 ↑書式は、[#,##0]
'//標準モジュールに登録してください。
Public Function String2Number(ByVal arg As Variant)
Const KETA1 As String = "十,百,千"
Const KETA2 As String = "万,億,兆"
Const WASU As String = "〇,一,二,三,四,五,六,七,八,九"
Dim nk1: nk1 = Array(10, 10 ^ 2, 10 ^ 3)
Dim nk2: nk2 = Array(10 ^ 4, 10 ^ 8, 10 ^ 12)
Dim k1: k1 = Split(KETA1, ",")
Dim k2: k2 = Split(KETA2, ",")
Dim i As Long, j As Long, fg As Long, n
Dim buf, buf1, buf2, buf3, f
Dim sTotal As Variant
Dim RegEx As Object
Dim Ms, m
Dim dblTotal As Double
Dim bufAr()
If arg = "" Then String2Number = 0: Exit Function
For Each n In Split(WASU, ",")
arg = Replace(arg, n, fg)
fg = fg + 1
Next
arg = Replace(arg, "円", "")
arg = Replace(arg, ",", "", , , vbTextCompare) '前回よりの補足
arg = Replace(arg, Space(1), "", , , vbTextCompare '""
arg = StrConv(arg, vbNarrow)
If IsNumeric(arg) Then String2Number = CDbl(arg): Exit Function
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.Pattern = "([^" & KETA2 & "]+)([" & KETA2 & "]*) '([^" & KETA2 & "]*)([" & KETA2 & "]*)"
Set Ms = .Execute(arg)
For Each m In Ms
buf1 = m.submatches(0)
If m.submatches.Count = 2 Then
buf2 = m.submatches(1)
End If
For i = 0 To 2
buf1 = Replace(buf1, k1(i), "*" & nk1(i) & "+", , 1)
If m.submatches.Count > 1 Then
buf2 = Replace(buf2, k2(i), nk2(i), , 1)
End If
Next
ReDim Preserve bufAr(j)
If Right(buf1, 1) = "+" Then buf1 = buf1 & "0"
If Left(buf1, 1) = "*" Then buf1 = "1" & buf1
If Right(buf2, 1) = "+" Then buf2 = buf2 & "0"
If Left(buf2, 1) = "*" Then buf2 = "1" & buf1
If Trim(buf2) <> "" Then
buf = Evaluate(buf1) * Evaluate(buf2)
Else
buf = Evaluate(buf1)
End If
sTotal = buf
bufAr(j) = sTotal
j = j + 1
sTotal = ""
buf1 = ""
buf2 = ""
buf = ""
Next
End With
For Each f In bufAr()
dblTotal = dblTotal + f
Next
String2Number = dblTotal
End Function
長期で数字を置く場合は、値コピーで定数化してください。
で作ったものを修正しました。カンマが入るとエラーになるからです。
String2Number関数というユーザー定義関数です。
これは、擬似的なNumberString関数の逆関数です。
NUMBERSTRING(セル,1) に対応もします。
結果は以下のようになります。それ以外の方法は知りません。
1400万 14,000,000
50百万円 50,000,000
24億5,639万5,000 2,456,395,000
800億96百万 80,096,000,000
4.4億 440,000,000
18億34万7,400 1,800,347,400
2兆2,562億7,500万 2,256,275,000,000
12億5,500万 1,255,000,000
22億3,766万 2,237,660,000
181億3,000万 18,130,000,000
String2Number関数 ↑書式は、[#,##0]
'//標準モジュールに登録してください。
Public Function String2Number(ByVal arg As Variant)
Const KETA1 As String = "十,百,千"
Const KETA2 As String = "万,億,兆"
Const WASU As String = "〇,一,二,三,四,五,六,七,八,九"
Dim nk1: nk1 = Array(10, 10 ^ 2, 10 ^ 3)
Dim nk2: nk2 = Array(10 ^ 4, 10 ^ 8, 10 ^ 12)
Dim k1: k1 = Split(KETA1, ",")
Dim k2: k2 = Split(KETA2, ",")
Dim i As Long, j As Long, fg As Long, n
Dim buf, buf1, buf2, buf3, f
Dim sTotal As Variant
Dim RegEx As Object
Dim Ms, m
Dim dblTotal As Double
Dim bufAr()
If arg = "" Then String2Number = 0: Exit Function
For Each n In Split(WASU, ",")
arg = Replace(arg, n, fg)
fg = fg + 1
Next
arg = Replace(arg, "円", "")
arg = Replace(arg, ",", "", , , vbTextCompare) '前回よりの補足
arg = Replace(arg, Space(1), "", , , vbTextCompare '""
arg = StrConv(arg, vbNarrow)
If IsNumeric(arg) Then String2Number = CDbl(arg): Exit Function
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.Pattern = "([^" & KETA2 & "]+)([" & KETA2 & "]*) '([^" & KETA2 & "]*)([" & KETA2 & "]*)"
Set Ms = .Execute(arg)
For Each m In Ms
buf1 = m.submatches(0)
If m.submatches.Count = 2 Then
buf2 = m.submatches(1)
End If
For i = 0 To 2
buf1 = Replace(buf1, k1(i), "*" & nk1(i) & "+", , 1)
If m.submatches.Count > 1 Then
buf2 = Replace(buf2, k2(i), nk2(i), , 1)
End If
Next
ReDim Preserve bufAr(j)
If Right(buf1, 1) = "+" Then buf1 = buf1 & "0"
If Left(buf1, 1) = "*" Then buf1 = "1" & buf1
If Right(buf2, 1) = "+" Then buf2 = buf2 & "0"
If Left(buf2, 1) = "*" Then buf2 = "1" & buf1
If Trim(buf2) <> "" Then
buf = Evaluate(buf1) * Evaluate(buf2)
Else
buf = Evaluate(buf1)
End If
sTotal = buf
bufAr(j) = sTotal
j = j + 1
sTotal = ""
buf1 = ""
buf2 = ""
buf = ""
Next
End With
For Each f In bufAr()
dblTotal = dblTotal + f
Next
String2Number = dblTotal
End Function
長期で数字を置く場合は、値コピーで定数化してください。
この回答へのお礼
お礼日時:2018/03/22 13:56
URL内のものでしたら使えました。
VBA触ったことない人には少し難しいかもしれないので補足します。
Excelのオプションからマクロを有効にして開発タブを出す。
開発タブのVisual basicをクリック
挿入→標準モジュールにURL内の式を貼り付け
バツマークで閉じる
ホーム→オートSUM→ユーザー定義関数
関数で処理したい場所の指定
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【マクロ】functionプロシージ...
-
googleのスプレッドシート
-
エクセル IF計算式?でしょうか?
-
エクセル折れ線グラフについて...
-
Excelで数値を時間数に変換する...
-
Excelの警告について
-
EXCELで数値が異なった数字を足...
-
エクセル、LibreOffice Calcプ...
-
【マクロ】for nest について ...
-
エクセルを使用して、円周率を...
-
Excelについて
-
エクセルの数式バーのフォント...
-
Excelについて。Excelに縦1列に...
-
エクセルでファイルの最終更新...
-
【マクロ】関数をセルに入力す...
-
【マクロ】AブックからBブック...
-
エクセルマクロを教えてほしい...
-
【マクロ】マクロが割当てされ...
-
エクセルのセルの書式ユーザー...
-
エクセルをエクセレントに究める
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
漢字混じりの数字表記を数字の...
-
中間周波数の求め方について
-
Excelについて教えてください ...
-
グレースケール画像を量子化す...
-
お気に入りのアドレス一覧表の...
-
スペースコブラの最終回
-
今日9月12日の「ウルルン滞...
-
仮面ライダービルド F1ザウルス...
-
F-1の海外サイトを教えて下さい!
-
カラオケJOYSOUNDについて
-
女子プロゴルフ メジャーの歴...
-
【F1】回生システムについての...
-
モナコGPの結果は?
-
日テレのDAISUKI!の歌のタイト...
-
CX系って何ですか?
-
大家族石田さんちの次の地上波...
-
パドックパスとピットウォーク...
-
藤子不二雄ワイドの終曲 DREAM...
-
フジテレビ サプライズの挿入歌
-
アニメ「PEACEMAKER...
おすすめ情報
ご回答有り難うございます。
VBAを使ったことがなかったのですが、
なんとか標準モジュールにはりつけました。
貼り付けて、コンパイル?をやってみると
arg = Replace(arg, Space(1), "", , , vbTextCompare '""←の部分が構文エラーになっているという表示が出てきました。
どのようにすればよいか
ご教示頂けますと幸いです。