1、如何自定義:
打開(kāi)EXCEL,新建一個(gè)文件Book1,按ALT+F11進(jìn)入VBA編程環(huán)境,選中這個(gè)BOOK1文件,插入模塊,將下面的源代碼復制到右邊的模塊代碼區內,然后將此BOOK1保存,保存類(lèi)型一定選加載宏,文件名嘛可自由發(fā)揮,我就填"中文大寫(xiě)",確定OK!然后回到EXCEL,工具--加載宏-找到"中文大寫(xiě)",打勾確定,我們這個(gè)自定義函數就可以象內置函數樣使用了!--->=rmbdx(123456.78),爽吧!
2、例子:
A、直接在函數內輸入數值的(請注意參數的用法,默認用法是不用輸入)
=rmbdx(123456.78)--->壹拾貳萬(wàn)叁仟肆佰伍拾陸元柒角捌分
=rmbdx(123456.78,0)--->壹拾貳萬(wàn)叁仟肆佰伍拾陸元柒角捌分
=rmbdx(123456.78,1)--->壹拾貳萬(wàn)叁仟肆佰伍拾陸元柒角捌分
=rmbdx(56.78)--->伍拾陸元柒角捌分
=rmbdx(0.78)--->柒角捌分
=rmbdx(0.784)--->柒角捌分
=rmbdx(0.785,1)--->柒角玖分
=rmbdx(0.02,1)--->貳分
B、引用某單元格數值進(jìn)行轉換的
假設你的D3單元格的數據(也可以是求和或其它公式得出的結果)需要轉換,大寫(xiě)格式放在D4單元格,則D4輸入公式:=rmbdx(d3)即可
C、其它形如=rmbdx(SUM(C4:C6))的也可以,用法象內置函數,請靈活使用
3、源代碼:
Function rmbdx(value, Optional m = 0)
‘中文大寫(xiě)源代碼,
‘支持負數,支持小數點(diǎn)后的第三位數是否進(jìn)行四舍五入處理
‘默認參數為0,即不將小數點(diǎn)后的第三位數進(jìn)行四舍五入處理
On Error Resume Next
Dim a
Dim jf As String ‘定義角分位
Dim j ‘定義角位
Dim f ‘定義分位
If value < 0 Then ‘處理正負數的情況
a = "負"
Else
a = ""
End If
If IsNumeric(value) = False Then ‘判斷待轉換的value是否為數值
rmbdx = "需轉換的內容非數值"
Else
value = Abs(CCur(value))
‘當參數m不輸入(默認為0)或為0時(shí),小數點(diǎn)后的第三數不進(jìn)行四舍五入處理
‘當參數m為1或其它數值時(shí),小數點(diǎn)后的第三數進(jìn)行四舍五入處理
If m = 0 Then
jf = Fix((value - Fix(value)) * 100)
value = Fix(value) + jf / 100
Else ‘厘位進(jìn)行四舍五入實(shí)踐很少用到,但還是要照顧到
value = Application.WorksheetFunction.Round(value, 2) ‘-->這句是關(guān)鍵!只用round有bug
jf = Round((value - Fix(value)) * 100, 0)
End If
If value = 0 Or value = "" Then ‘當待轉換數值為0或空時(shí),不進(jìn)行轉換
rmbdx = ""
Else
strrmbdx = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" ‘轉換整數位
If Int(value) = 0 Then
strrmbdx = ""
End If
If Int(value) <> value Then
If jf > 9 Then ‘判斷小數位
j = Left(jf, 1)
f = Right(jf, 1)
Else
j = 0
f = jf
End If
If j <> 0 And f <> 0 Then ‘角分位都有時(shí)
jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角" _
& Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
Else
‘處理出現零幾分的情況
If Int(value) = 0 And j = 0 And f <> 0 Then
jf = Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
Else
If j = 0 Then ‘有分無(wú)角時(shí)
jf = "零" & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
Else
If f = 0 Then ‘有角無(wú)分時(shí)
jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角整"
End If
End If
End If
End If
strrmbdx = strrmbdx & jf ‘組裝
Else
strrmbdx = strrmbdx & "整"
End If
rmbdx = a & strrmbdx ‘最后成型了,MM滿(mǎn)意了吧
End If
End If
End Function