VBA编写自定义函数数字转换大写

laoau138

VBA编写自定义函数数字转换大写

一沫昔阳虹w

用自定义函数好难，用方法结合工作表捣腾几下应该可以出来
https://zhidao.baidu.com/question/519457782.html

grf1973

1. Function dx(q)
   
2.     YBB = Round(q * 100) '将输入的数值扩大100倍，进行四舍五入
   
3.     Y = Int(YBB / 100) '截取出整数部分
   
4.     J = Int(YBB / 10) - Y * 10 '截取出十分位
   
5.     F = YBB - Y * 100 - J * 10 '截取出百分位[DBNum2][$-804]G/通用格式
   
6.     ZY = Application.WorksheetFunction.Text(Y, "[DBNum2]") '将整数部分转为中文大写
   
7.     ZJ = Application.WorksheetFunction.Text(J, "[DBNum2]") '将十分位转为中文大写
   
8.     ZF = Application.WorksheetFunction.Text(F, "[DBNum2]") '将百分位转为中文大写
   
9.     dx = ZY & "元" & "整"
   
10.     d1 = ZY & "元"
    
11.     If F <> 0 And J <> 0 Then
    
12.       dx = d1 & ZJ & "角" & ZF & "分"
    
13.       If Y = 0 Then
    
14.                dx = ZJ & "角" & ZF & "分"
    
15.          End If
    
16.     End If
    
17.     If F = 0 And J <> 0 Then
    
18.        dx = d1 & ZJ & "角" & "整"
    
19.        If Y = 0 Then
    
20.           dx = ZJ & "角" & "整"
    
21.        End If
    
22.     End If
    
23.     If F <> 0 And J = 0 Then
    
24.       dx = d1 & ZJ & ZF & "分"
    
25.       If Y = 0 Then
    
26.          dx = ZF & "分"
    
27.       End If
    
28.     End If
    
29.     If q = "" Then
    
30.        dx = 0 '如没有输入任何数值为0
    
31.     End If
    
32.     dx = Replace(dx, "-", "负")
    
33. End Function
    

复制代码

grf1973

重新编了一个，3楼的好象对负小数会出错。

1. Function dx(q)
   
2.     dx = Application.WorksheetFunction.Text(Val(q), "[DBNum2]") '将整数部分转为中文大写
   
3.     p = InStr(dx, ".")
   
4.     If p = 0 Then
   
5.         dx = dx & "元" & "整"
   
6.     Else
   
7.         Mid(dx, p, 1) = "元"
   
8.         If Len(dx) = p + 1 Then
   
9.             dx = dx & "角"
   
10.         ElseIf Len(dx) = p + 2 Then
    
11.             dx = Left(dx, p + 1) & "角" & Right(dx, 1) & "分"
    
12.         End If
    
13.     End If
    
14.     dx = Replace(dx, "-", "负")
    
15. End Function

复制代码

一沫昔阳虹w

grf1973 发表于 2016-12-9 10:19
重新编了一个，3楼的好象对负小数会出错。

    dx = Application.WorksheetFunction.Text(Val(q), "[DBNum2]") '将整数部分转为中文大写
    学习了，请问 "[DBNum2]"   这个从哪来的呢？谢谢

grf1973

工作表函数TEXT的参数之一。

laoau138

grf1973 发表于 2016-12-9 10:19
重新编了一个，3楼的好象对负小数会出错。

太过高手了

laoau138

一沫昔阳虹w 发表于 2016-12-9 09:19
用自定义函数好难，用方法结合工作表捣腾几下应该可以出来
https://zhidao.baidu.com/question/519457782. ...

• Function upCurrency(num)        '小写金额转大写
•         Dim Curr$, CString$, i%, CurrLength%, str1$, str2$, str3$
•         Curr = Format(Abs(Val(num)) * 100, "0")
•         CurrLength = Len(Curr)
•         For i = 0 To CurrLength - 1
•                 str1 = Mid(Curr, CurrLength - i, 1)
•                 str2 = Mid("零壹贰叁肆伍陆柒捌玖", str1 + 1, 1)
•                 str3 = Mid("分角元拾佰仟万拾佰仟亿拾佰仟", i + 1, 1)
•                 CString = str2 & str3 & CString
•         Next
•         With CreateObject("VBScript.RegExp")
•                 .Global = True
•                 .Pattern = "(零[仟佰拾角分]+)+零?"
•                 CString = .Replace(CString, "零")
•                 .Pattern = "零?([亿万元])(零万)?|^零$"
•                 CString = .Replace(CString, "$1")
•                 .Pattern = "零$"
•                 CString = .Replace(CString, "整")
•         End With
•         upCurrency = IIf(num < 0, "负", "") & CString
• End Function
  

但是实在是好东西，圆、元、块、毛 的几种大写写法都可以转换。

• Function DxToN(ss) '大写金额转小写
•     For i% = 1 To 9
•         ss = Replace(ss, Mid("壹贰叁肆伍陆柒捌玖", i, 1), i)
•         ss = Replace(ss, Mid("一二三四五六七八九", i, 1), i)
•     Next
•     For i% = Len(ss) To 1 Step -1
•         s$ = Mid$(ss, i, 1)
•         X% = InStr("分角圆拾佰仟万拾佰仟亿拾佰仟兆", s)
•         If X = 0 Then X% = InStr("分毛元十百千万十百千亿十百千兆", s)
•         If X = 0 Then X% = InStr("分毛块十百千万十百千亿十百千兆", s)
•         If X Then j% = IIf(j% < X, X, ((j - 3) \ 4) * 4 + X)
•         If Val(s) Then m# = m# + (s & String(j - 1, "0")) / 100
•     Next
•     DxToN = Round(m, 2)
•     If InStr(ss, "-") Or InStr(ss, "负") Then DxToN = -DxToN
• End Function
  

一沫昔阳虹w

grf1973 发表于 2016-12-9 12:43
工作表函数TEXT的参数之一。

不好意思，涨分了，没反应过来，选成负分了

一沫昔阳虹w

laoau138 发表于 2016-12-9 12:53

Function upCurrency(num)        '小写金额转大写

        Dim Curr$, CString$, i%, Cu ...

不好意思，涨分了，没反应过来，选成负分了