请教用<em>VBA</em>把数值转为中文大写

首先，第一步要，选择要设置格式的数据区域，
第二步，右击在快捷菜单中选择“设zd置单元格格式”，
第三步，在弹出的对话框中选择“数字”选项卡，在列表内中选择“特殊”，
第四步，再在右边的列表中选择“中文大写数字”，最容后点击确定。

哦呵呵，这个代码是数字转大写的，不能有小数
Public Function NumberToWord(ByVal Number As Double)
Dim i As Long, j As Long
Dim S_Money As String
Dim D_Location As Long
Dim AfterDot As String
Dim BeforeDot As String
Dim AllString As String
Dim Corner As Long
Dim Separately As Long
Dim T_Str As String
Dim T_Str2 As String
Dim u As String
S_Money = Trim(Str(Number))
D_Location = InStr(1, S_Money, ".")
'小数点后处理
If D_Location Then
T_Str = Right(S_Money, Len(S_Money) - D_Location)
AfterDot = "点"
For i = 1 To Len(T_Str)
AfterDot = AfterDot & NToWord(Val(Mid(T_Str, i, 1)))
Next i
S_Money = Left(S_Money, D_Location - 1)
End If
'整数7a686964616fe58685e5aeb9339部分处理
T_Str = ""
j = Len(S_Money)
For i = 1 To Len(S_Money)
T_Str = T_Str & NToWord(Val(Mid(S_Money, i, 1))) & LevelToWord(j)
j = j - 1
Next i
'“零*”筛查
For i = 1 To Len(T_Str) Step 2
If Mid(T_Str, i, 1) = "零" Then
If Mid(T_Str, i + 1, 1) = LevelToWord(5) Or Mid(T_Str, i + 1, 1) = LevelToWord(9) Then T_Str2 = T_Str2 & Mid(T_Str, i + 1, 1)
Else
T_Str2 = T_Str2 & Mid(T_Str, i, 2)
End If
Next i
'“亿万”筛查
BeforeDot = Replace(T_Str2, "亿万", "亿")
If Number = 0 Then BeforeDot = NumberToWord(0)
NumberToWord = BeforeDot & AfterDot
End Function
然后还有两个函数：
Public Function NToWord(ByVal Number As Long)
Select Case Number
Case 0
NToWord = "零"
Case 1
NToWord = "壹"
Case 2
NToWord = "贰"
Case 3
NToWord = "叁"
Case 4
NToWord = "肆"
Case 5
NToWord = "伍"
Case 6
NToWord = "陆"
Case 7
NToWord = "柒"
Case 8
NToWord = "捌"
Case 9
NToWord = "玖"
Case Else
NToWord = ""
End Select
End Function
用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 '只能转换一亿亿元以e69da5e887aae79fa5e98193337下数目的货币！

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)。

使用Text函数即可。
如将78转换为七十八：=Text(78,"[dbnum1]")
如将78转换为柒拾捌：=Text(78,"[dbnum2]")
数字可以为单元格引用，也就是把78改为A1形式。