想把小写数字转换成中文的一二三.....并且是带小数点的

风云际会6

想把小写数字转换成中文的一二三.....并且是带小数点的
例如12.5转成一二点五
现在得到了你的提示，我已做成了相关的宏，如下

Sub te()
Dim aa, ss, bb, cc, ar, ad, hh, sd
aa = Application.Find(".", A1, 1)
ss = [NUMBERSTRING(Left(A1, Find(".", A1, 1) - 1), 3)]
cc = IsError(Application.Find(".", Range("A1"), 1))
bb = [NUMBERSTRING(Right(A1, Len(A1) - Find(".", A1, 1)), 3)]
ar = [NUMBERSTRING(Right(A1, Len(A1) - Find(".", A1, 1)), 3)]
ad = "点"
sd = [NUMBERSTRING(A1,3)]
'Range("A5") = [If(cc, sd, ss & ad & bb)]
If cc = False Then
Range("A5") = ss & ad & bb
End If
If cc = True Then
Range("A5") = sd

End If
End Sub
我在2010版可以运行，我现在是想把它变成函数，但变不了，你可以帮我？

maditate

Sub 中文小数点()
     中文数 = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九")
     数据 = 12.5
     For h = 1 To Len(数据)
         数 = Mid(数据, h, 1)
         If 数 <> "." Then
           中文 = 中文 & 中文数(数)
         Else
            中文 = 中文 & "点"
         End If         
     Next h
  MsgBox 中文
End Sub

白云2011

maditate 发表于 2011-9-18 15:23
Sub 中文小数点()
     中文数 = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九")
    ...

改进版zzzzz vvvvvvvvvvvvvvvvvvvvvvvvvvvvv.rar (6.62 KB, 下载次数: 29)

2011-9-18 15:39 上传

点击文件名下载附件

白云2011

不知道为什么0.1的第一位是.而不是0
再参考这个
Function yy(r As Range) As String
z = Array("零", "一", "二", "三", "四", "五", "六", "七", "八", "九", "点")
If Left(r, 1) = "." Then yy = "零"
For m = 1 To Len(r)
    If Mid(r, m, 1) = "." Then yy = yy & z(10) Else yy = yy & z(Mid(r, m, 1))
Next m
End Function

linlingo

好复杂，我就看看的

风云际会6

maditate 发表于 2011-9-18 15:23
Sub 中文小数点()
     中文数 = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九")
    ...

谢谢了，不过我还是想让成为公式，可以？

maditate

风云际会6 发表于 2011-9-18 16:05
谢谢了，不过我还是想让成为公式，可以？

白云为你做好了，

白云2011

原因已查明请看：

wpxxsyzx

仅供参考：
Private Sub CommandButton1_Click()
Dim arr
arr = Array("零", "一", "二", "三", "四", "五", "六", "七", "八", "九", "点")
Range("a4") = Replace(Range("a4").Text, ".", arr(10))
For i = 0 To 9
    Range("a4") = Replace(Range("a4").Text, i, arr(i))
Next
End Sub

flysum2008

这几天在看wpxxsyzx老师讲解的正则表达式，跟着用正则做了个，不成熟，已经写了，就传上来吧,期望老师提供正则的精简代码

1. Sub cc()
   
2.     Dim regex As Object
   
3.     Set regex = CreateObject("vbscript.regexp")
   
4.     regex.Global = True
   
5.     regex.IgnoreCase = True
   
6.     arr = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")
   
7.     brr = Array("零", "一", "二", "三", "四", "五", "六", "七", "八", "九", "点")
   
8.     For y = 1 To 5
   
9.         jg = Range("a" & y)
   
10.         For i = 0 To 9
    
11.             j = arr(i)
    
12.             k = brr(i)
    
13.             regex.Pattern = [j]
    
14.             jg = regex.Replace(jg, k)
    
15.         Next i
    
16.         Range("e" & y) = jg
    
17.     Next y
    
18. End Sub

复制代码