用VBA自定義一個大寫金額轉換的函數,在公式中輸入此函數名就能夠了。
具體方法:按 Alt+F11 ,在VBA編輯器菜單中點 插入→模塊,將下面的函數複製到插入的模塊當中,
'===================================================================
Function CChinese(StrEng As String) As String
'將阿拉伯數字轉成中文字的程式例如:1560890 轉成 "壹佰伍拾陸萬零捌佰玖拾"。
'程式限制爲不可輸入超過16個數字
If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Like "*-*" Then
If Trim(StrEng) <> "" Then MsgBox "無效的數字"
CChinese = "": Exit Function
End If
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
strEng2Ch = "零壹貳叄肆伍陸柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 萬億兆"
StrEng = CStr(CDec(StrEng))
intLen = Len(StrEng)
For intCounter = 1 To intLen
strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
If strTempCh = "零" And intLen <> 1 Then
If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = ""
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
End If
If (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) \ 4 + 1, 1)
If intCounter > 3 Then
If Mid(StrEng, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
End If
End If
strCh = strCh & Trim(strTempCh)
Next
CChinese = strCh
End Function
'===================================================================
'===================================================================
Function daxie(money As String) As String
'實現貨幣金額中文大寫轉換的程序
'程式限制爲不可輸入超過16個數字
Dim x As String, y As String
Const zimu = ".sbqwsbqysbqwsbq" '定義位置代碼
Const letter = "0123456789sbqwy.zjf" '定義漢字縮寫
Const upcase = "零壹貳叄肆伍陸柒捌玖拾佰仟萬億圓整角分" '定義大寫漢字
If CDbl(money) >= 1E+16 Then daxie = "#VALUE!": Exit Function '只能轉換一億億元如下數目的貨幣!
x = Format(money, "0.00") '格式化貨幣
y = ""
For i = 1 To Len(x) - 3
y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)
Next
If Right(x, 3) = ".00" Then
y = y & "z" '***元整
Else
y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f" '*元*角*分
End If
y = Replace(y, "0q", "0") '避免零千(如:40200肆萬零千零貳佰)
y = Replace(y, "0b", "0") '避免零百(如:41000肆萬壹千零佰)
y = Replace(y, "0s", "0") '避免零十(如:204貳佰零拾零肆)
y = Replace(y, "0j", "0") '避免零角
y = Replace(y, "0f", "") '避免零分
Do While y <> Replace(y, "00", "0")
y = Replace(y, "00", "0") '避免雙零(如:1004壹仟零零肆)
Loop
y = Replace(y, "0y", "y") '避免零億(如:210億 貳佰壹十零億)
y = Replace(y, "0w", "w") '避免零萬(如:210萬 貳佰壹十零萬)
y = IIf(x < 0.1, Right(y, Len(y) - 3), y) '避免零幾分(如:0.01零壹分;0.04零肆分)
y = IIf(Len(x) = 5 And Left(y, 1) = "1", Right(y, Len(y) - 1), y) '避免壹十(如:14壹拾肆;10壹拾)
y = IIf(Len(x) = 4, Replace(y, "0.", ""), Replace(y, "0.", ".")) '避免零元(如:20.00貳拾零圓;0.12零圓壹角貳分)
For i = 1 To 19
y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大寫漢字
Next
daxie = y
End Function
'===================================================================
回到Excel工做表中,若要轉化A1單元格的數字,則可在其餘任意單元格中輸入公式 =CChinese(A1)。要轉換成大寫金額,則可在其餘任意單元格中輸入公式 =daxie(A1)。編輯器