vba货币数字转大写

A. 用VBA变成把小写金额转换成大写

=IF(A1<0,"金额为负无效",IF(OR(A1=0,A1=""),"零元整",(IF(A1<1,"(人民币此告)",TEXT(INT(A1),"[dbnum2]G/通用格式")&"元"&IF(INT(A1)*100-INT(A1*100)=0,"整",IF(INT(A1*10)-INT(A1)*10=0,"零"&TEXT((INT(A1*100)-INT(A1*10)*10),"[dbnum2]")&"分",IF(INT(A1*10)*10-INT(A1*100)=0,TEXT(INT(A1*10)-INT(A1)*10,"[dbnum2]")&"角整",TEXT(INT(A1*10)-INT(A1)*10,"[dbnum2]")&"角"&TEXT((INT(A1*100)-INT(A1*10)*10),森李明"[dbnum2]")&"分")))))))

上面是大写的解决方法,身份证要自己动加校验码?那和实际上的会不对扰郑啊.有兴趣加QQ群28052038.有高手帮你.

B. vb代码：一个方法可将数字金额变为大写

'大写 Const strN = "零壹贰叁肆伍陆柒捌玖" Const strG = "拾佰仟万亿" Const intN = "0123456789" Dim Zero_Count As Long '读零计数 Private Const ERROR_SUCCESS = 0& Private Const ERROR_BADDB = 1009& Private Const ERROR_BADKEY = 1010& Private Const ERROR_CANTOPEN = 1011& Private Const ERROR_CANTREAD = 1012& Private Const ERROR_CANTWRITE = 1013& Private Const ERROR_OUTOFMEMORY = 14& Private Const ERROR_INVALID_PARAMETER = 87& Private Const ERROR_ACCESS_DENIED = 5& Private Const ERROR_NO_MORE_ITEMS = 259& Private Const ERROR_MORE_DATA = 234& Private Function GetN(ByVal N As Long) As String GetN = Mid(strN, N + 1, 1) End Function Private Function GetG(ByVal G As Long) As String Select Case G Case 1 GetG = "" Case 2, 6 GetG = Mid(strG, 1, 1) Case 3, 7 GetG = Mid(strG, 2, 1) Case 4, 8 GetG = Mid(strG, 3, 1) Case 5 GetG = Mid(strG, 4, 1) Case 9 GetG = Mid(strG, 5, 1) End Select End Function Private Function ReadLongNumber(ByVal LongX As String) As String Dim NumberX As String Dim l As Long '长度 Dim m As Long '多余位数 Dim c As Long '循环次数 Dim i As Long, j As Long '标志 Dim CurN As String NumberX = LongX l = Len(NumberX) Do Until l < 9 m = l Mod 8 If m = 0 Then m = 8 CurN = Left(NumberX, m) If ReadIntNumber(CurN) <> "零" Then ReadLongNumber = ReadLongNumber & ReadIntNumber(CurN) & "亿" Else ReadLongNumber = ReadLongNumber & "亿" End If NumberX = Right(NumberX, Len(NumberX) - m) l = Len(NumberX) Loop ReadLongNumber = ReadLongNumber & ReadIntNumber(NumberX) If Len(ReadLongNumber) > 2 And Right(ReadLongNumber, 1) = "零" Then '去尾 零 ReadLongNumber = Left(ReadLongNumber, Len(ReadLongNumber) - 1) End If If Mid(ReadLongNumber, 1, 2) = "壹拾" Then '掐头 壹拾 ReadLongNumber = Right(ReadLongNumber, Len(ReadLongNumber) - 1) Mid(ReadLongNumber, 1, 1) = "拾" End If Zero_Count = 0 End Function Private Function ReadIntNumber(ByVal NumberX As String) As String Dim l As Long '长度 Dim m As Long '多余位数 Dim c As Long '循环次数 Dim i As Long, j As Long '标志 Dim CurN As String If Val(NumberX) = 0 Then ReadIntNumber = GetN(0): Exit Function l = Len(NumberX) If l > 8 Then Exit Function m = l Mod 9 CurN = Right(NumberX, m) For i = Len(CurN) To 1 Step -1 If GetN(Int(Mid(CurN, i, 1))) = "零" And Zero_Count = 1 Then If GetG(Len(CurN) - i + 1) = "万" Then If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber End If Else If GetN(Int(Mid(CurN, i, 1))) = "零" Then ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber If GetG(Len(CurN) - i + 1) = "万" Then If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber End If Zero_Count = 1 Else ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber Zero_Count = 0 End If End If Next i 'Loop If Len(ReadIntNumber) > 2 And Right(ReadIntNumber, 1) = "零" Then '去尾 零 ReadIntNumber = Left(ReadIntNumber, Len(ReadIntNumber) - 1) End If If Mid(ReadIntNumber, 1, 2) = "壹拾" Then '掐头 壹拾 ReadIntNumber = Right(ReadIntNumber, Len(ReadIntNumber) - 1) Mid(ReadIntNumber, 1, 1) = "拾" End If End Function Public Function ReadNumber(ByVal NumberX As String) As String Dim LongX As String Dim PointX As String Dim LongLong As Long Dim bFS As Boolean '负数 If Not IsNumeric(NumberX) Then ReadNumber = "" Exit Function End If If CDbl(NumberX) < 0 Then NumberX = -NumberX bFS = True End If NumberX = CStr(Format(NumberX, "General Number")) LongLong = InStr(1, NumberX, ".") If LongLong <> 0 Then ReadNumber = ReadLongNumber(Left(NumberX, LongLong - 1)) ReadNumber = ReadNumber & "点" & ReadSmallNumber(Right(NumberX, Len(NumberX) - LongLong)) Else ReadNumber = ReadLongNumber(NumberX) End If If bFS = True Then ReadNumber = "负" & ReadNumber End If End Function Private Function ReadSmallNumber(SmallNumber As String) As String Dim i As Long For i = 1 To Len(SmallNumber) ReadSmallNumber = ReadSmallNumber & GetN(Mid(SmallNumber, i, 1)) Next i End Function Private Function ReadSmallNumberToRMB(SmallNumber As String) As String ReadSmallNumberToRMB = GetN(Mid(SmallNumber, 1, 1)) & "角" & GetN(Mid(SmallNumber, 2, 1)) & "分" End Function Public Function ReadNumberToRMB(ByVal NumberX As String) As String Dim LongX As String Dim PointX As String Dim LongLong As Long Dim bFS As Boolean '负数 If Not IsNumeric(NumberX) Then ReadNumberToRMB = "" Exit Function End If If CDbl(NumberX) < 0 Then NumberX = -NumberX bFS = True End If NumberX = CStr(Format(NumberX, "#.00")) LongLong = InStr(1, NumberX, ".") If Right(NumberX, Len(NumberX) - LongLong) <> "" Then ReadNumberToRMB = ReadLongNumber(Left(NumberX, LongLong - 1)) ReadNumberToRMB = ReadNumberToRMB & "元" & ReadSmallNumberToRMB(Right(NumberX, Len(NumberX) - LongLong)) Else ReadNumberToRMB = ReadLongNumber(NumberX) End If If bFS = True Then ReadNumberToRMB = "负" & ReadNumberToRMB End If End Function

C. VBA 如何将数字转换为中文大写

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

D. VBA 如何将数字转换为中文大写

根据数字的读法，写了一个把数字转成中文字符串的程序
参数一为数字
参数二为是不是反回人民币大写
参数三为是不是直接读数字，否则带有十百或差巧等单位
参数四为设置小数点后面的位数，默认为4

使用衫键方法是
t=GetChinaNum(20005.000436, , , 7)'返回 “二千零五点零零零四三六”
t=GetChinaNum(2005.436, True, , 7)'返回“贰庆肆仟零伍元肆角肆分”
t=GetChinaNum(2005.436, , True, 7)'返加“二零零五点四三六”
下面是程序代码

Function GetChinaNum(otherNum As Double, Optional isRMB As Boolean, Optional numOption As Boolean, Optional dotNum As Integer) As String

On Error Resume Next

num = Trim(Str(Int(otherNum)))

If isRMB Then

numwei = "拾佰仟万拾佰仟亿拾佰仟"

numshu = "零壹贰叁肆伍陆柒捌玖拾"

Else

numwei = "十百千万十百千亿十百千"

numshu = "零一二三四五六七八九十"

End If

If otherNum < 20 And otherNum >= 10 Then

num = Right(num, 1)

GetChinaNum = Left(numwei, 1)

End If

For i = 1 To Len(num)

bstr = Mid(num, i, 1)

If numOption Then

GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)

Else

GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)

If bstr = "0" Then

If Mid(numwei, Len(num) - i, 1) = "万" Or Mid(numwei, Len(num) - i, 1) = "亿" Then

Do While Right(GetChinaNum, 1) = "零"

GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)

Loop

GetChinaNum = GetChinaNum + Mid(numwei, Len(num) - i, 1)

End If

Else

GetChinaNum = GetChinaNum + Mid(numwei, Len(num) - i, 1)

End If

GetChinaNum = Replace(GetChinaNum, "零零", "零")

End If

Next i

If numOption = False Then

Do While Right(GetChinaNum, 1) = "零"

GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)

Loop

End If

If isRMB Then

numrmb = "元角分"

GetChinaNum = GetChinaNum + Mid(numrmb, 1, 1)

If Val(num) <> otherNum Then

num = Trim(Str(Round(otherNum - Val(num), 2)))

For i = 2 To Len(num)

bstr = Mid(num, i, 1)

GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1) + Mid(numrmb, i, 1)

Next i

Else

GetChinaNum = GetChinaNum + "整"

End If

Else

If Val(num) <> otherNum Then

If dotNum = 0 Then dotNum = 4

num = Trim(CStr(Round(otherNum - Val(num), dotNum)))

If GetChinaNum = "" Then GetChinaNum = "零"

GetChinaNum = GetChinaNum + "点"

For i = 2 To Len(num)

bstr = Mid(num, i, 1)

GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)

Next i

End If

End If

End Function

E. VBA 如何将数字转换为中文大写

哦呵呵，这个代码是数字转大写的，不能有小数
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
'整数部分处理
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
发不下了，等补充。。。。

F. 求会计函数高手(在EXCEL中用VBA自定义一个大写金额转换的函数,例如：1560890 转成 "壹佰伍拾陆万零捌佰玖

="人民币:"蠢扰&IF(L41="","",IF(ROUND(L41,2)=0,"零",IF(ROUND(L41,2)<1,""此高,TEXT(INT(ROUND(L41,2)),"[dbnum2]")&"元")&IF(INT(ROUND(L41,2)*10)-INT(ROUND(L41,2))*10=0,IF(INT(ROUND(L41,2))*(INT(ROUND(L41,2)*100)-INT(ROUND(L41,2)*10)*10)=0,"","零"),TEXT(INT(ROUND(L41,2)*10)-INT(ROUND(L41,2))*10,"森档尺[dbnum2]")&"角")&IF((INT(ROUND(L41,2)*100)-INT(ROUND(L41,2)*10)*10)=0,"整",TEXT((INT(ROUND(L41,2)*100)-INT(ROUND(L41,2)*10)*10),"[dbnum2]")&"分")))

G. 如何在excel中设置公式将数字转换为英文大写金额

使用数字转英文货币大写“自定义函数”，具体使用方法如下：

所需材料：Excel、数字转英文货币大写自定义函数（可通过网络复制粘贴）。

一、首先打开Excel表格文件，按Alt+F11打开VBA窗口，插入一个“模块”。

H. Excel用VBA转换数字大写

Function
DX(M)'185个字符
DX
=
IIf(Abs(M)
<
0.005,
a,
Replace(Replace(Replace(Join(Application.Text(Split(Format(M,
"带弊搭
0.
0
0")),
Split("
[DBnum2]
[DBnum2]圆0角;;圆零
[DBnum2]0分;;整")),
a),
"零圆零",
a),
"零圆"卜中,
a),
"零整",
"整"蠢拿))
End
Function

I. 请问如何用VBA在单元格中输入金额小写转大写公式

请参考以下公式：
="人民币：" & IF($M12<0.005,"",IF($M12<0,"负",) & IF(INT(ABS($M12)),TEXT(INT(ABS($M12)),"[dbnum2]")&"元",) & IF(INT(ABS($M12)*10)-INT(ABS($M12))*10,TEXT(INT(ABS($M12)*10)-INT(ABS($M12))*10,"[dbnum2]") & "角",IF(INT(ABS($M12))=ABS(A3),,IF(ABS($M12)<枯老做0.1,,"零"))) & IF(ROUND(ABS($M12)*100-INT(ABS($M12)*10)*10,),TEXT(ROUND(ABS($M12)*100-INT(ABS($M12)*10)*10,),"含绝[dbnum2]") & "分","整"))
(以上公式没衡得以向下填充)

J. 请问在Excel里怎么用VBA把中文大写的数字转换成阿拉伯数字

Sub 人民币大写转数字()
Dim reg As Object, arr, b$, a
arr = Range("a1:a" & [a65536].End(xlUp).Row)
For i = 1 To UBound(arr)
a = Split(arr(i, 1), "元")
k = Len(arr(i, 1))
If Right(a(0), 1) = "佰" Then a(0) = a(0) & "零零": k = k + 2
If Right(a(0), 1) = "拾" Then a(0) = a(0) & "零": k = k + 1
a(0) = a(0) & "."
a = Join(a, "")
Do While x <前棚悉 k
x = x + 1
Select Case Mid(a, x, 1)
Case "壹"
b = b & 1
Case "贰"
b = b & 2
Case "叁"
b = b & 3
Case "肆"
b = b & 4
Case "伍"
b = b & 5
Case "陆"
b = b & 6
Case "柒"
b = b & 7
Case "捌"
b = b & 8
Case "玖"
b = b & 9
Case "零"
b = b & 0
Case "万"
b = b & ""
Case "仟"
b = b & ""
Case "佰慧乎"
b = b & ""
Case "拾"
b = b & ""
Case "角"
b = b & ""
Case "分"
b = b & "和差"
Case "."
b = b & "."
End Select
Loop
Range("a" & i) = "￥" & b & "元"
b = "": a = "": x = 0
Next
End Sub