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