楼主
kevinchengcw |
Q: 如何提取指定的中文大写数值并转换成阿拉伯数值？
A: 以下示例涉及如下知识点：
1. 正则提取指定中文大写数值;
2. 字典用于存放对应表;
3. 中文大写数值转换为阿拉伯数值;
4. 正则替换的用法。
代码如下：- Sub test()
- Dim RegEx, Dic, Arr
- Dim M, N As Integer
- Dim mMatch As Match
- Dim Matches As matchcollection
- Dim Str, Tmp As String
- Set RegEx = CreateObject("vbscript.regexp") '创建正则表达式用于提取对应数值
- Set Dic = CreateObject("scripting.dictionary") '创建字典用于存储转换成宽体的数字与对应的阿拉伯数字
- With RegEx '建立正则规则
- .Global = True
- .Pattern = "([一二三四五六七八十九]*社)|([一二三四五六七八十九]*号)"
- End With
- For N = 0 To 9 '添加宽体字与阿拉伯数字对应表存入字典中
- Dic.Add StrConv(N, vbWide), N
- Next N
- For N = 2 To Cells(Rows.Count, 1).End(3).Row '循环取A列的数据区内容
- Str = Cells(N, 1).Value '赋值给字符串，便于操作
- Set Matches = RegEx.Execute(Str) '取得符合规则的数据集
- Cells(N, 3) = Cells(N, 1).Value '先将A列的值赋给C列（呵呵，节省个变量）
- For Each mMatch In Matches '提取每个对应数据，转换后替换原字符串中对应内容
- Cells(N, 3) = Replace(Cells(N, 3).Value, Left(mMatch.Value, Len(mMatch.Value) - 1), CtoA(Left(mMatch.Value, Len(mMatch.Value) - 1))) '替换语句，注意其中调用了自定义的转换函数
- Next mMatch
- Next N
- Arr = Dic.keys '将字典的keys赋值给数组，便于取用
- For M = LBound(Arr) To UBound(Arr) '将C列的宽体字阿拉伯数字替换成普通数字
- ActiveSheet.Columns(3).Replace Arr(M), Dic(Arr(M))
- Next M
- End Sub
- Function CtoA(ByVal Rng) '自定义的中文大写数值转换为阿拉伯数值的函数
- Dim Arr, Arr2, Dic
- Dim Str As String
- Dim M, N, I As Long
- Set Dic = CreateObject("scripting.dictionary") '创建字典用于存储转换值
- Dic.Add "千", "*1000+"
- Dic.Add "仟", "*1000+"
- Dic.Add "百", "*100+"
- Dic.Add "佰", "*100+"
- Dic.Add "十", "*10+"
- Dic.Add "拾", "*10+"
- Dic.Add "九", "9"
- Dic.Add "玖", "9"
- Dic.Add "八", "8"
- Dic.Add "捌", "8"
- Dic.Add "七", "7"
- Dic.Add "柒", "7"
- Dic.Add "六", "6"
- Dic.Add "陆", "6"
- Dic.Add "五", "5"
- Dic.Add "伍", "5"
- Dic.Add "四", "4"
- Dic.Add "肆", "4"
- Dic.Add "三", "3"
- Dic.Add "叁", "3"
- Dic.Add "二", "2"
- Dic.Add "贰", "2"
- Dic.Add "一", "1"
- Dic.Add "壹", "1"
- Arr = Dic.keys '将字典的keys赋值给数组，便于取用
- If Rng <> "" Then
- Str = Rng
- Str = Replace(Str, "亿", vbTab) '将万和亿替换成分隔符便于分开计算
- Str = Replace(Str, "万", vbTab)
- For M = LBound(Arr) To UBound(Arr) '循环替换对应的大写数字为对应阿拉伯数字
- Str = Replace(Str, Arr(M), Dic(Arr(M)))
- Next M
- Str = Replace(Str, "零", "") '替换掉多余的字符
- Str = Replace(Str, "+*", "*")
- Arr2 = Split(Str, vbTab) '拆分字符串为数组，方便各数量级的数字累加
- I = 0
- For M = LBound(Arr2) To UBound(Arr2)
- If Right(Arr2(M), 1) = "+" Then Arr2(M) = Left(Arr2(M), Len(Arr2(M)) - 1) '替换两种可能存在的情况
- If Left(Arr2(M), 1) = "*" Then Arr2(M) = Right(Arr2(M), Len(Arr2(M)) - 1)
- If Arr2(M) = "" Then
- If M < UBound(Arr2) Then I = I + 10000 ^ (UBound(Arr2) - M)
- Else
- If InStr(Arr2(M), "*") > 0 Or InStr(Arr2(M), "+") > 0 Then
- I = I + Evaluate(Arr2(M)) * 10000 ^ (UBound(Arr2) - M)
- Else
- I = I + Arr2(M) * 10000 ^ (UBound(Arr2) - M)
- End If
- End If
- Next M
- CtoA = I '返回结果
- End If
- Application.Volatile '设置为易失性函数，可以即时更新
- Set Dic = Nothing '清空项目
- End Function
附示例文件。
 请问怎样用公式实现这样的替换？.rar
|