求一个中文小写自定义函数：函数中回避使用worksheetfunction

weiyingde

求一个中文小写自定义函数：函数中回避使用worksheetfunction。
是这样，这个函数要在powerpoint使用，你知道，要调用worksheetfunction前提是要启动Excel，而我又不想在后台启动Excel，原因我在调用worksheetfunction时ppt老出错误，所以只好规避Excel了。
大侠若有其他的路子也请指教。

micch

中文小写？？啥意思，中文数字吗；写一个小于十万的自然数，中文小写，不考虑小数和负数

1. Function num(x)
   
2.     x = Int(x)
   
3.     If x < 10 Then
   
4.              num = Mid("零一二三四五六七八九十百千万", x + 1, 1)
   
5.     Else
   
6.             num = num(Left(x, 1)) & Mid("个十百千万", Len(x), 1)
   
7.             If Val(Mid(x, 2)) Then num = num & IIf(Mid(x, 2, 1) = "0", "零", "") & num(Mid(x, 2))
   
8.     End If
   
9. End Function

复制代码

microyip

之前不是有人闲无聊一直在讨论这个问题吗？翻查一下帖子就好了

lss001

'*********************
Function numTotext(x)
Set ex = CreateObject("excel.application")
numTotext = ex.Evaluate("NUMBERSTRING(""" & x & """,3)")
End Function
Sub ntx()
    MsgBox numTotext(123456789)
End Sub

weiyingde

micch 发表于 2020-3-2 11:28
中文小写？？啥意思，中文数字吗；写一个小于十万的自然数，中文小写，不考虑小数和负数

是的，将阿拉伯数字实现中文小写。谢谢你，这个可以用一些，只可惜有一定的限制。

weiyingde

microyip 发表于 2020-3-2 11:58
之前不是有人闲无聊一直在讨论这个问题吗？翻查一下帖子就好了

是的，找了好多，有很多用了工作表函数。

weiyingde

lss001 发表于 2020-3-2 13:40
Sub bb() 'PPT自带大小写转换函数LCase
    s = LCase("ABBCCC")
End Sub

你这是字母大小写吧？要实现1-一；2-二，3-三、4-四……这样的转换。

micch

weiyingde 发表于 2020-3-2 14:25
是的，将阿拉伯数字实现中文小写。谢谢你，这个可以用一些，只可惜有一定的限制。

根据需要写嘛，如果不会遇到负数和小数，那代码就不需要处理了，如果数字大于10万，还得加内容
如果写完全通用的，有点麻烦

weiyingde

micch 发表于 2020-3-2 14:32
根据需要写嘛，如果不会遇到负数和小数，那代码就不需要处理了，如果数字大于10万，还得加内容
如果写完 ...

那就凑合着用吧，学艺不精，只好将就着。

mzbao

网上有很多不用工作表函数实现阿拉伯数字转人民币大写的代码，仅把它改一改，就可以变成阿拉伯数字转小写中文了。

1. Function NumToCN(ByVal Num)
   
2.     Application.Volatile True
   
3.     Num = Trim(Num)
   
4.     If Not IsNumeric(Num) Then NumToCN = "#N/A": Exit Function
   
5.     Place = "分角点十百千万十百千亿十百千万"
   
6.     Dn = "一二三四五六七八九"
   
7.     D1 = "整〇元〇〇〇万〇〇〇亿〇〇〇万"
   
8.     If Num < 0 Then FuHao = "（负）"
   
9.     Num = Format(Abs(Num), "###0.00") * 100
   
10.     If Num > 999999999999999# Then: NumToCN = "数字超出转换范围!!": Exit Function
    
11.     If Num = 0 Then: NumToCN = "〇": Exit Function
    
12.     NumA = Trim(Str(Num))
    
13.     NumLen = Len(NumA)
    
14.     For j = NumLen To 1 Step -1     ' 数字转换过程
    
15.       temp = Val(Mid(NumA, NumLen - j + 1, 1))
    
16.       If temp <> 0 Then             ' 非〇数字转换
    
17.          numc = numc & Mid(Dn, temp, 1) & Mid(Place, j, 1)
    
18.       Else                          ' 数字〇的转换
    
19.          If Right(numc, 1) <> "〇" Then
    
20.            numc = numc & Mid(D1, j, 1)
    
21.          Else
    
22.            Select Case j            ' 特殊数位转换
    
23.                 Case 1
    
24.                   numc = Left(numc, Len(numc) - 1) & Mid(D1, j, 1)
    
25.                 Case 3, 11
    
26.                   numc = Left(numc, Len(numc) - 1) & Mid(D1, j, 1) & "〇"
    
27.                 Case 7
    
28.                   If Mid(numc, Len(numc) - 1, 1) <> "亿" Then
    
29.                      numc = Left(numc, Len(numc) - 1) & Mid(D1, j, 1) & "〇"
    
30.                   End If
    
31.                 Case Else
    
32.            End Select
    
33.          End If
    
34.       End If
    
35.     Next
    
36.     For i = 1 To 4
    
37.         numc = Replace(numc, Mid("分角元整", i, 1), "")
    
38.     Next
    
39.     If Right(numc, 1) = "点" Then numc = Replace(numc, "点", "")
    
40.     NumToCN = FuHao & Trim(numc)
    
41. End Function

复制代码