vb.net金額轉大室的簡單介紹

vb.net 如何把大寫金額轉換成阿拉伯數字金額？

Private Sub Text2_Change() '大寫金額轉換成阿拉伯數字金額

創新互聯提供高防服務器、云服務器、香港服務器、成都多線服務器托管等

Dim i As Integer

Dim j As Integer

Dim myint As Integer

Dim myint1 As Integer

Dim mydoub As Double

Dim mystr As String

Dim mystr1 As String

Dim mystr2 As String

Dim mystr3 As String

Dim mystr4 As String

Dim money As Long

Dim money1 As Integer

Dim money2 As Long

mystr = Text2.Text

myint = InStr(mystr, ".")

If myint = 0 Then

mystr = Text2.Text

Else

mystr3 = Right(Text2.Text, Len(Text2.Text) - myint)

If mystr3 "" Then '轉換小數位

mystr4 = Left(mystr3, 1)

mystr3 = Right(mystr3, Len(mystr3) - 1)

If mystr4 "0" Then

mystr2 = mystr2 + setdata(Val(mystr4)) + "角"

End If

If mystr3 "" Then

mystr4 = Left(mystr3, 1)

mystr2 = mystr2 + setdata(Val(mystr4)) + "分"

End If

mystr = Left(Text2.Text, myint - 1)

End If

j = Len(mystr)

For i = 1 To Len(mystr) '轉換整數位

money2 = Left(mystr, i)

money1 = Right(money2, 1)

If money1 = 0 Then

If j = 5 Then

If Right(mystr1, 1) "萬" Then mystr1 = mystr1 "萬"

Else

If Right(mystr1, 1) "零" And Right(money, j) 0 Then mystr1 = mystr1 "零"

End If

Else

mystr1 = mystr1 setdata(money1) + chang(j)

End If

j = j - 1

Next i

Text1.Text = mystr1 "元" mystr2 '顯示大寫

End Sub

求vb金額小寫轉為大寫的代碼，帶詳細注釋的！！！！

轉自

將阿拉伯數字轉換為漢字數字,支持到百萬億(比如大寫金額)

例子:

Debug.Print UpNumber(-612325646566.46,0,True )

負陸仟壹佰貳拾叁億貳仟伍佰陸拾肆萬陸仟伍佰陸拾陸圓肆角陸分

Debug.Print UpNumber(-125646566.46,1,True )

負一億二千五百六十四萬六千五百六十六元四角六分

Debug.Print UpNumber(-125646566.46,1,flase )

負一億二千五百六十四萬六千五百六十六點四六

Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String

'********************************************************************************

'--------------------------------------------------------------------------------

'將阿拉伯數字轉換為大寫字符串

'--------------------------------------------------------------------------------

'參數說明:

'Number 待轉換的數字,可以是小數.

'Typ 轉換類型,可選值 0,1

'0 轉換為零,壹,貳等

'1 轉換為一,二,三等

'IsMoney 是否是金額,如果是,則轉換為多少元,小數后轉換為多少角,分,反之則轉換為類似于"二點三"這種形式

'--------------------------------------------------------------------------------

'返回值說明:

'如果成功,返回轉換后的字符串

'如果失敗,返回空字符串

'--------------------------------------------------------------------------------

'注意,由于 Double 類型數值范圍的原因,此函數最大只支持到百萬億

'沒有對 Typ 的值進行檢查,如果 Typ 不為 0,1 之一,將會引發錯誤.

'另,由于 Double 類型數值范圍的原因,超過百萬億,將不能顯示小數,同樣的超過十萬億只能顯示一個小數,以此類推.

'--------------------------------------------------------------------------------

'********************************************************************************

On Error GoTo Doerr

Dim Result As String '返回值

Dim strNumber As String '文本型的 Number

Dim lngNumberLen As Long '文本型的 Number 的 Len

Dim strTmp As String

Dim strFirst As String, strEnd As String

Dim lngI As Long, lngJ As Long, lngTmp As Long

Dim strNum(10) As String '大寫數字

Dim strUnit(16) As String '單位,比如十,拾,萬等

Dim strUnitB(2) As String '小數后的單位

'初始化

Select Case Typ

Case 0

strNum(0) = "零": strNum(1) = "壹": strNum(2) = "貳": strNum(3) = "叁"

strNum(4) = "肆": strNum(5) = "伍": strNum(6) = "陸": strNum(7) = "柒"

strNum(8) = "捌": strNum(9) = "玖"

If IsMoney Then

strUnit(0) = "圓"

strUnitB(0) = "角": strUnitB(1) = "分"

Else

strUnit(0) = "點"

End If

strUnit(1) = "拾": strUnit(2) = "佰": strUnit(3) = "仟": strUnit(4) = "萬"

strUnit(5) = "拾": strUnit(6) = "佰": strUnit(7) = "仟": strUnit(8) = "億"

strUnit(9) = "拾": strUnit(10) = "佰": strUnit(11) = "仟": strUnit(12) = "萬"

strUnit(13) = "拾": strUnit(14) = "佰": strUnit(15) = "仟"

Case 1

strNum(0) = "零": strNum(1) = "一": strNum(2) = "二": strNum(3) = "三"

strNum(4) = "四": strNum(5) = "五": strNum(6) = "六": strNum(7) = "七"

strNum(8) = "八": strNum(9) = "九"

If IsMoney Then

strUnit(0) = "元"

strUnitB(0) = "角": strUnitB(1) = "分"

Else

strUnit(0) = "點"

End If

strUnit(1) = "十": strUnit(2) = "百": strUnit(3) = "千": strUnit(4) = "萬"

strUnit(5) = "十": strUnit(6) = "百": strUnit(7) = "千": strUnit(8) = "億"

strUnit(9) = "十": strUnit(10) = "百": strUnit(11) = "千": strUnit(12) = "萬"

strUnit(13) = "十": strUnit(14) = "百": strUnit(15) = "千"

Case Else

'參數錯誤

GoTo Errexit

End Select

Result = ""

If Number = 0 Then

If IsMoney Then

Result = strNum(0) strUnit(0) "整"

Else

Result = strNum(0)

End If

Else

If IsMoney Then

strNumber = Trim(str(FormatCurrency(Number, 2, vbTrue, vbFalse, vbFalse))) '保留兩位小數

Else

strNumber = Trim(str(Number)) '簡單的轉換為字符串型

End If

lngNumberLen = Len(strNumber)

If Left(strNumber, 1) = "-" Then '處理負數

strFirst = "負"

strNumber = Right(strNumber, lngNumberLen - 1)

lngNumberLen = lngNumberLen - 1

Else

strFirst = "" '通常不需要 =""

End If

lngI = InStrRev(strNumber, ".")

If lngI Then

strTmp = Right(strNumber, lngNumberLen - lngI)

If IsMoney Then

strTmp = strTmp "00"

strEnd = "" '通常不需要 =""

For lngJ = 1 To 2

Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1))) strUnitB(lngJ - 1)

Else

strTmp = Right(strNumber, lngNumberLen - lngI)

For lngJ = 1 To lngNumberLen - lngI

Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1)))

End If

strNumber = Left(strNumber, lngI - 1) '去除小數部分

lngNumberLen = Len(strNumber) '新的字符串長度

Else

If IsMoney Then

strEnd = "整"

Else

strEnd = ""

End If

'以下為主循環部分

lngI = 0

For lngJ = lngNumberLen To 1 Step -1

lngTmp = CLng(Mid$(strNumber, lngJ, 1))

If lngTmp Then

Result = strNum(lngTmp) strUnit(lngI) Result

Else

If lngI = 0 Or lngI = 4 Or lngI = 8 Or lngI = 12 Then '超過 16 位不支持

Result = strNum(lngTmp) strUnit(lngI) Result

Else

Result = strNum(lngTmp) Result

End If

lngI = lngI + 1

Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零

'億零萬零圓", "億圓"

Result = Replace(Result, strUnit(8) strNum(0) strUnit(4) strNum(0) strUnit(0), strUnit(8) strUnit(0))

Result = Replace(Result, strUnit(8) strNum(0) strUnit(4), strUnit(8) strNum(0)) '億零萬, "億零"

Result = Replace(Result, strUnit(4) strNum(0) strUnit(0), strUnit(4) strUnit(0)) '億零萬", "億零

Result = Replace(Result, strNum(0) strUnit(8), strUnit(8)) '零億

Result = Replace(Result, strNum(0) strUnit(4), strUnit(4)) '零萬

Result = Replace(Result, strNum(0) strUnit(0), strUnit(0)) '零圓

Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零

If IsMoney Then

Result = strFirst Result strEnd

Else

Result = strFirst Result

If Right(Result, 1) = strUnit(0) Then Result = Left(Result, Len(Result) - 1) '去除最后一個 "點"

End If

Complete:

GoTo Quit

Doerr:

Errexit:

Result = ""

Quit:

UpNumber = Result

End Function

VB 金額小寫轉成大寫

這個vb是沒有現成的函數的，給你一個函數你參考下：

Public Function ConvToMoney(ByVal Digital As String) As String

Dim strChi(11), strDig(10) As String

Dim sTmp, rsStr As String

Dim lenStr As Byte

Dim laststr As String

If Not IsNumeric(Digital) Then

ConvToMoney = ""

Exit Function

End If

If Val(Format(Digital)) 0 Then

Digital = Trim(Str(Abs(Val(Format(Digital)))))

laststr = "整(負)"

Else

laststr = "整"

End If

strChi(0) = "分"

strChi(1) = "角"

strChi(2) = "元"

strChi(3) = "拾"

strChi(4) = "佰"

strChi(5) = "仟"

strChi(6) = "萬"

strChi(7) = "拾"

strChi(8) = "佰"

strChi(9) = "仟"

strChi(10) = "億"

strDig(0) = "零"

strDig(1) = "壹"

strDig(2) = "貳"

strDig(3) = "叁"

strDig(4) = "肆"

strDig(5) = "伍"

strDig(6) = "陸"

strDig(7) = "柒"

strDig(8) = "捌"

strDig(9) = "玖"

sTmp = Digital

If (Len(sTmp) = 0) Or (Len(sTmp) 11) Then

ConvToMoney = ""

Exit Function

End If

sTmp = Format(sTmp, "########.00")

If Len(sTmp) 11 Then

ConvToMoney = ""

Exit Function

End If

lenStr = Len(sTmp)

rsStr = strDig(Val(MID(sTmp, lenStr - 1, 1))) strChi(1) strDig(Val(Right(sTmp, 1))) strChi(0)

sTmp = Left(sTmp, Len(sTmp) - 3)

Dim i, d As Byte

Dim blnZero As Boolean

Dim stmprv, dstr As String

For i = 1 To Len(sTmp)

stmprv = MID(sTmp, i, 1) stmprv

For i = 1 To Len(stmprv)

d = Val(MID(stmprv, i, 1))

If d = 0 Then

If i = 1 Or i = 5 Then

dstr = strChi(i + 1)

Else

If Not blnZero Then

dstr = strDig(0)

Else

dstr = ""

End If

blnZero = True

Else

dstr = strDig(d) strChi(i + 1)

blnZero = False

End If

rsStr = dstr + rsStr

ConvToMoney = rsStr laststr

End Function

標題名稱：vb.net金額轉大室的簡單介紹
標題來源：http://m.kartarina.com/article46/hgsphg.html

成都網站建設公司_創新互聯，為您提供虛擬主機、響應式網站、全網營銷推廣、面包屑導航、軟件開發、服務器托管

聲明：本網站發布的內容（圖片、視頻和文字）以用戶投稿、用戶轉載內容為主，如果涉及侵權請盡快告知，我們將會在第一時間刪除。文章觀點不代表本網站立場，如需處理請聯系客服。電話：028-86922220；郵箱：631063699@qq.com。內容未經允許不得轉載，或轉載時需注明來源：創新互聯

猜你還喜歡下面的內容