![](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で質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) MID関数について 2 2022/04/22 09:13
- 経営学 10.90億円とは 3 2022/10/15 13:14
- その他(社会・学校・職場) 一億五千万、全て数字で表すとどうなりますか? 5 2023/01/16 11:48
- 数学 この数字は写真の数字(時価総額)は 9兆34,4億07百万円 と言う読み方で良いのですか? 分かる方 3 2022/09/13 12:57
- 政治 私の発明した「二階建て漢字」は使えるでしょうか? 3 2023/02/08 16:40
- くじ・懸賞 ロト7の質問です。 1 2022/03/29 11:36
- 経営学 大きな数字の読み方について 1 2022/10/15 14:21
- 政治 沿線住民の利益を考えれば、赤字路線は切り捨てるのは当然ではないか? 4 2022/04/12 08:59
- 経営学 1兆5000億円は数字で表すと? 2 2022/10/11 17:02
- パズドラ ゲームの上限値が21億な理由 2 2023/06/18 12:34
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
IFとIFS関数
-
Excelを無料で使うには? パソ...
-
セルの数を求めたい
-
エクセルの数式バーのフォント...
-
Excelの表示についての質問
-
再質問です。マクロの修正箇所...
-
データチェックを行うエクセル...
-
Excelに詳しい方! B列が「日...
-
西暦や和暦の表示をyyyymmdd表...
-
Excelで50個のセルに同じ文字を...
-
Excelの数式について教えてくだ...
-
Excel VBAで全ての矢印を赤色に...
-
エクセル関数を使って
-
祝日と土曜、日曜の合計をカウ...
-
xlsxファイルを保存する際にPDF...
-
Excelについて
-
エクセルVBA、別ブックへ転記す...
-
エクセルで「ページレイアウト...
-
2列に入っているデータを1列...
-
【ExcelVBA】名前を付けて保存→...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
漢字混じりの数字表記を数字の...
-
中間周波数の求め方について
-
フィボナッチ数列で30項までの...
-
スペースコブラの最終回
-
F-1の海外サイトを教えて下さい!
-
「ホンダF1」の歴代のエンジン
-
松本英子さんのニューシングル...
-
【F1】回生システムについての...
-
キミライコネンについて
-
仮面ライダービルド F1ザウルス...
-
F1のワールドチャンピオン
-
グレースケール画像を量子化す...
-
ウィルス??
-
女子プロゴルフ メジャーの歴...
-
2015年F1GP
-
Excelについて教えてください ...
-
お気に入りのアドレス一覧表の...
-
カラオケJOYSOUNDについて
-
モナコGPの結果は?
-
今日9月12日の「ウルルン滞...
おすすめ情報
ご回答有り難うございます。
VBAを使ったことがなかったのですが、
なんとか標準モジュールにはりつけました。
貼り付けて、コンパイル?をやってみると
arg = Replace(arg, Space(1), "", , , vbTextCompare '""←の部分が構文エラーになっているという表示が出てきました。
どのようにすればよいか
ご教示頂けますと幸いです。