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ランキング
-
グレースケール画像を量子化す...
-
漢字混じりの数字表記を数字の...
-
YAMAHAのミッションカートの操...
-
フジテレビってなぜ不安を煽る...
-
「5日に王子さんが来る」という...
-
CX系って何ですか?
-
夢で逢えたらのエンディング曲
-
LAST IMPRESSION
-
「フジテレビです。」
-
パドックパスとピットウォーク...
-
GT300の変速機構に関する質問です
-
フジテレビ山中章子さんにファ...
-
アニメキャッツアイのエンディ...
-
トトロの歌詞どなたかしりませ...
-
藤子不二雄ワイドの終曲 DREAM...
-
日テレのDAISUKI!の歌のタイト...
-
アニメ「PEACEMAKER...
-
M1グランプリ2008を見逃しまし...
-
装置
-
劇場版ターンAガンダム「月光...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
漢字混じりの数字表記を数字の...
-
Excelについて教えてください ...
-
お気に入りのアドレス一覧表の...
-
中間周波数の求め方について
-
【F1】回生システムについての...
-
この1/3って、どこから来たんで...
-
フジテレビってなぜ不安を煽る...
-
「5日に王子さんが来る」という...
-
アニメ「PEACEMAKER...
-
ライブのときによく使われてい...
-
CX系って何ですか?
-
A-StudioのエンディングBGMにつ...
-
日テレのDAISUKI!の歌のタイト...
-
F1のフランソワセベールの事故。
-
サイバーフォーミュラ(無印)の...
-
藤子不二雄ワイドの終曲 DREAM...
-
フォーミュラカーのお尻のライ...
-
パドックパスとピットウォーク...
-
西成区にあった今宮市民病院の...
-
いつもオカズにしているAV女優...
おすすめ情報
ご回答有り難うございます。
VBAを使ったことがなかったのですが、
なんとか標準モジュールにはりつけました。
貼り付けて、コンパイル?をやってみると
arg = Replace(arg, Space(1), "", , , vbTextCompare '""←の部分が構文エラーになっているという表示が出てきました。
どのようにすればよいか
ご教示頂けますと幸いです。