[已解决]把大写变成小写数字

zss7758258

根据A列得出B列的结果，函数也好VBA也好，出结果就行了，谢谢老师们！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-1-22 11:01

1. Function TxtToDigits(Xstr) As Long      '汉字转数字
   
2.     If InStr(Xstr, "万") > 0 Then
   
3.         x = Split(Xstr, "万")
   
4.         TxtToDigits = Four_Digits(x(0)) * 10000# + Four_Digits(x(1))
   
5.     Else
   
6.         TxtToDigits = Four_Digits(Xstr)
   
7.     End If
   
8. End Function
   
9. 
   
10. Function Four_Digits(Xstr) As Integer      '四位数
    
11.     arr = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
    
12.     Set d = CreateObject("scripting.dictionary")
    
13.     For i = 0 To UBound(arr)
    
14.         d(arr(i)) = i + 1
    
15.     Next
    
16.     If Xstr Like "十*" Then Xstr = Replace(Xstr, "十", "一十")
    
17.     Xstr = Replace(Xstr, "零", "")
    
18.     If InStr(Xstr, "千") > 0 Then
    
19.         x = Left(Xstr, 1): Four_Digits = d(x) * 1000: Xstr = Replace(Xstr, x & "千", "")
    
20.     End If
    
21.     If InStr(Xstr, "百") > 0 Then
    
22.         x = Left(Xstr, 1): Four_Digits = Four_Digits + d(x) * 100: Xstr = Replace(Xstr, x & "百", "")
    
23.     End If
    
24.     If InStr(Xstr, "十") > 0 Then
    
25.         x = Left(Xstr, 1): Four_Digits = Four_Digits + d(x) * 10: Xstr = Replace(Xstr, x & "十", "")
    
26.     End If
    
27.     If Len(Xstr) > 0 Then Four_Digits = Four_Digits + d(Left(Xstr, 1))
    
28. End Function
    

复制代码

跳转到最佳答案楼层

雪舞子

楼主再提问题需做好附件并模拟好结果上传上来，方便大家帮你。

1. Sub test()
   
2.     Dim arr, i%, j%
   
3.     arr = Range("a1:a" & [a65536].End(3).Row)
   
4.     For i = 1 To UBound(arr)
   
5.         If arr(i, 1) Like "十*" Then arr(i, 1) = Replace(arr(i, 1), "十", "一十")
   
6.         For j = 1 To 100
   
7.             If Application.Text(j, "[dbnum1]") = arr(i, 1) Then arr(i, 1) = j: Exit For
   
8.         Next
   
9.     Next
   
10.     [b1].Resize(i - 1) = arr
    
11. End Sub

复制代码

中文数字转阿拉伯数字.rar (14.83 KB, 下载次数: 10)

2015-1-21 11:19 上传

点击文件名下载附件

grf1973

1. Function TxtToDigits(Xstr) As Long      '汉字转数字
   
2.     If InStr(Xstr, "万") > 0 Then
   
3.         x = Split(Xstr, "万")
   
4.         TxtToDigits = Four_Digits(x(0)) * 10000# + Four_Digits(x(1))
   
5.     Else
   
6.         TxtToDigits = Four_Digits(Xstr)
   
7.     End If
   
8. End Function
   
9. 
   
10. Function Four_Digits(Xstr) As Integer      '四位数
    
11.     arr = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
    
12.     Set d = CreateObject("scripting.dictionary")
    
13.     For i = 0 To UBound(arr)
    
14.         d(arr(i)) = i + 1
    
15.     Next
    
16.     If Xstr Like "十*" Then Xstr = Replace(Xstr, "十", "一十")
    
17.     Xstr = Replace(Xstr, "零", "")
    
18.     If InStr(Xstr, "千") > 0 Then
    
19.         x = Left(Xstr, 1): Four_Digits = d(x) * 1000: Xstr = Replace(Xstr, x & "千", "")
    
20.     End If
    
21.     If InStr(Xstr, "百") > 0 Then
    
22.         x = Left(Xstr, 1): Four_Digits = Four_Digits + d(x) * 100: Xstr = Replace(Xstr, x & "百", "")
    
23.     End If
    
24.     If InStr(Xstr, "十") > 0 Then
    
25.         x = Left(Xstr, 1): Four_Digits = Four_Digits + d(x) * 10: Xstr = Replace(Xstr, x & "十", "")
    
26.     End If
    
27.     If Len(Xstr) > 0 Then Four_Digits = Four_Digits + d(Left(Xstr, 1))
    
28. End Function
    

复制代码

grf1973

可到99999999。