Private Sub Text2_Change() '大寫(xiě)金額轉(zhuǎn)換成阿拉伯?dāng)?shù)字金額

成都創(chuàng)新互聯(lián)一直通過(guò)網(wǎng)站建設(shè)和網(wǎng)站營(yíng)銷幫助企業(yè)獲得更多客戶資源。 以"深度挖掘,量身打造,注重實(shí)效"的一站式服務(wù),以成都網(wǎng)站建設(shè)、網(wǎng)站設(shè)計(jì)、移動(dòng)互聯(lián)產(chǎn)品、成都全網(wǎng)營(yíng)銷服務(wù)為核心業(yè)務(wù)。10余年網(wǎng)站制作的經(jīng)驗(yàn),使用新網(wǎng)站建設(shè)技術(shù),全新開(kāi)發(fā)出的標(biāo)準(zhǔn)網(wǎng)站,不但價(jià)格便宜而且實(shí)用、靈活,特別適合中小公司網(wǎng)站制作。網(wǎng)站管理系統(tǒng)簡(jiǎn)單易用,維護(hù)方便,您可以完全操作網(wǎng)站資料,是中小公司快速網(wǎng)站建設(shè)的選擇。
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 '轉(zhuǎn)換小數(shù)位
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
End If
mystr = Left(Text2.Text, myint - 1)
End If
j = Len(mystr)
For i = 1 To Len(mystr) '轉(zhuǎn)換整數(shù)位
money2 = Left(mystr, i)
money1 = Right(money2, 1)
If money1 = 0 Then
If j = 5 Then
If Right(mystr1, 1) "萬(wàn)" Then mystr1 = mystr1 "萬(wàn)"
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 '顯示大寫(xiě)
End Sub
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
Dim s As String = "0Ff0ajkh04624F"
Dim i As Integer = 0
Dim sTemp As String = ""
Dim ss As String = ""
For i = 1 To Strings.Len(s)
sTemp = Mid(s, i, 1)
If Asc(sTemp) = 65 And Asc(sTemp) = 90 Then
sTemp = LCase(sTemp)
ElseIf Asc(sTemp) = 95 And Asc(sTemp) = 122 Then
sTemp = UCase(sTemp)
Else
sTemp = sTemp
End If
ss = ss sTemp
Next
MsgBox(ss)
End Sub
Public Function je(ByVal szje As Double) As String
Dim s As String = ""
Dim sz() As String = {"零", "壹", "貳", "叁", "肆", "伍", "陸", "柒", "捌", "玖"}
Dim dw() As String = {"圓", "拾", "佰", "千", "萬(wàn)", "拾", "佰", "仟", "拾", "佰", "仟"}
If szje 0 Then
s = "負(fù)"
szje = Math.Abs(szje)
End If
Dim zh() As String = Split(Str(szje), ".")
If zh.Length 2 Then
Return "ERROR:格式錯(cuò)"
Exit Function
End If
zh(0) = Trim(zh(0))
zh(1) = Trim(zh(1))
Dim i As Integer
For i = 1 To Len(zh(0))
s = s sz(Val(Mid(zh(0), i, 1))) dw(Len(zh(0)) - i)
Next
For i = 1 To Len(zh(1))
s = s sz(Val(Mid(zh(1), i, 1))) Choose(i, "角", "分", "厘", "毫")
Next
s = s "整"
Return s
End Function
轉(zhuǎn)自
將阿拉伯?dāng)?shù)字轉(zhuǎn)換為漢字?jǐn)?shù)字,支持到百萬(wàn)億(比如大寫(xiě)金額)
例子:
Debug.Print UpNumber(-612325646566.46,0,True )
負(fù)陸仟壹佰貳拾叁億貳仟伍佰陸拾肆萬(wàn)陸仟伍佰陸拾陸圓肆角陸分
Debug.Print UpNumber(-125646566.46,1,True )
負(fù)一億二千五百六十四萬(wàn)六千五百六十六元四角六分
Debug.Print UpNumber(-125646566.46,1,flase )
負(fù)一億二千五百六十四萬(wàn)六千五百六十六點(diǎn)四六
Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String
'********************************************************************************
'--------------------------------------------------------------------------------
'將阿拉伯?dāng)?shù)字轉(zhuǎn)換為大寫(xiě)字符串
'--------------------------------------------------------------------------------
'參數(shù)說(shuō)明:
'Number 待轉(zhuǎn)換的數(shù)字,可以是小數(shù).
'Typ 轉(zhuǎn)換類型,可選值 0,1
'0 轉(zhuǎn)換為 零,壹,貳 等
'1 轉(zhuǎn)換為 一,二,三 等
'IsMoney 是否是金額,如果是,則轉(zhuǎn)換為多少元,小數(shù)后轉(zhuǎn)換為多少角,分,反之則轉(zhuǎn)換為類似于"二點(diǎn)三"這種形式
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'返回值說(shuō)明:
'如果成功,返回轉(zhuǎn)換后的字符串
'如果失敗,返回空字符串
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'注意,由于 Double 類型數(shù)值范圍的原因,此函數(shù)最大只支持到百萬(wàn)億
'沒(méi)有對(duì) Typ 的值進(jìn)行檢查,如果 Typ 不為 0,1 之一,將會(huì)引發(fā)錯(cuò)誤.
'另,由于 Double 類型數(shù)值范圍的原因,超過(guò)百萬(wàn)億,將不能顯示小數(shù),同樣的超過(guò)十萬(wàn)億只能顯示一個(gè)小數(shù),以此類推.
'--------------------------------------------------------------------------------
'********************************************************************************
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 '大寫(xiě)數(shù)字
Dim strUnit(16) As String '單位,比如 十,拾,萬(wàn)等
Dim strUnitB(2) As String '小數(shù)后的單位
'初始化
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) = "點(diǎn)"
End If
strUnit(1) = "拾": strUnit(2) = "佰": strUnit(3) = "仟": strUnit(4) = "萬(wàn)"
strUnit(5) = "拾": strUnit(6) = "佰": strUnit(7) = "仟": strUnit(8) = "億"
strUnit(9) = "拾": strUnit(10) = "佰": strUnit(11) = "仟": strUnit(12) = "萬(wàn)"
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) = "點(diǎn)"
End If
strUnit(1) = "十": strUnit(2) = "百": strUnit(3) = "千": strUnit(4) = "萬(wàn)"
strUnit(5) = "十": strUnit(6) = "百": strUnit(7) = "千": strUnit(8) = "億"
strUnit(9) = "十": strUnit(10) = "百": strUnit(11) = "千": strUnit(12) = "萬(wàn)"
strUnit(13) = "十": strUnit(14) = "百": strUnit(15) = "千"
Case Else
'參數(shù)錯(cuò)誤
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))) '保留兩位小數(shù)
Else
strNumber = Trim(str(Number)) '簡(jiǎn)單的轉(zhuǎn)換為字符串型
End If
lngNumberLen = Len(strNumber)
If Left(strNumber, 1) = "-" Then '處理負(fù)數(shù)
strFirst = "負(fù)"
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)
Next
Else
strTmp = Right(strNumber, lngNumberLen - lngI)
For lngJ = 1 To lngNumberLen - lngI
Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1)))
Next
End If
strNumber = Left(strNumber, lngI - 1) '去除小數(shù)部分
lngNumberLen = Len(strNumber) '新的字符串長(zhǎng)度
Else
If IsMoney Then
strEnd = "整"
Else
strEnd = ""
End If
End If
'以下為主循環(huán)部分
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 '超過(guò) 16 位不支持
Result = strNum(lngTmp) strUnit(lngI) Result
Else
Result = strNum(lngTmp) Result
End If
End If
lngI = lngI + 1
Next
Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零
Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零
'億零萬(wàn)零圓", "億圓"
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)) '億零萬(wàn), "億零"
Result = Replace(Result, strUnit(4) strNum(0) strUnit(0), strUnit(4) strUnit(0)) '億零萬(wàn)", "億零
Result = Replace(Result, strNum(0) strUnit(8), strUnit(8)) '零億
Result = Replace(Result, strNum(0) strUnit(4), strUnit(4)) '零萬(wàn)
Result = Replace(Result, strNum(0) strUnit(0), strUnit(0)) '零圓
Result = Replace(Result, strNum(0) strNum(0), strNum(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) '去除最后一個(gè) "點(diǎn)"
End If
End If
Complete:
GoTo Quit
Doerr:
Errexit:
Result = ""
Quit:
UpNumber = Result
End Function
網(wǎng)站名稱:vb.net金額大小寫(xiě),vb區(qū)分大小寫(xiě)
URL網(wǎng)址:http://chinadenli.net/article2/dsgssoc.html
成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián),為您提供網(wǎng)站改版、App設(shè)計(jì)、品牌網(wǎng)站建設(shè)、小程序開(kāi)發(fā)、定制網(wǎng)站、網(wǎng)站營(yíng)銷
聲明:本網(wǎng)站發(fā)布的內(nèi)容(圖片、視頻和文字)以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主,如果涉及侵權(quán)請(qǐng)盡快告知,我們將會(huì)在第一時(shí)間刪除。文章觀點(diǎn)不代表本網(wǎng)站立場(chǎng),如需處理請(qǐng)聯(lián)系客服。電話:028-86922220;郵箱:631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載,或轉(zhuǎn)載時(shí)需注明來(lái)源: 創(chuàng)新互聯(lián)
猜你還喜歡下面的內(nèi)容