將阿拉伯數(shù)字轉換為漢字數(shù)字,支持到百萬億(比如大寫金額)
'例子:
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
'********************************************************************************
'--------------------------------------------------------------------------------
'將阿拉伯數(shù)字轉換為大寫字符串
'Version 1.0 2002-02-06
'Version 1.1 2002-04-05 修改到支持到千億
'Version 1.2 2004-08-14 修改為支持 Typ,IsMoney 參數(shù),轉換結果可以不是金額,支持到百萬億
'Version 1.21 2004-08-15 修正 Typ=1 時,不能顯示負數(shù)的疏忽.
'Roadbeg
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'參數(shù)說明:
'Number 待轉換的數(shù)字,可以是小數(shù).
'Typ 轉換類型,可選值 0,1
'0 轉換為 零,壹,貳 等
'1 轉換為 一,二,三 等
'IsMoney 是否是金額,如果是,則轉換為多少元,小數(shù)后轉換為多少角,分,反之則轉換為類似于"二點三"這種形式
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'返回值說明:
'如果成功,返回轉換后的字符串
'如果失敗,返回空字符串
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'注意,由于 Double 類型數(shù)值范圍的原因,此函數(shù)最大只支持到百萬億
'沒有對 Typ 的值進行檢查,如果 Typ 不為 0,1 之一,將會引發(fā)錯誤.
'另,由于 Double 類型數(shù)值范圍的原因,超過百萬億,將不能顯示小數(shù),同樣的超過十萬億只能顯示一個小數(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 '大寫數(shù)字
Dim strUnit(16) As String '單位,比如 十,拾,萬等
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) = "點"
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
'參數(shù)錯誤
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)) '簡單的轉換為字符串型
End If
lngNumberLen = Len(strNumber)
If Left(strNumber, 1) = "-" Then '處理負數(shù)
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)
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) '新的字符串長度
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 '超過 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)) '零零", "零
'億零萬零圓", "億圓"
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)) '零零", "零
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
End If
Complete:
GoTo Quit
Doerr:
Errexit:
Result = ""
Quit:
UpNumber = Result
End Function
(責任編輯：admin)
- ·關于 Partition 函數(shù)在分組查詢中的應
- ·Access算術運算符的含義和說明表
- ·mid函數(shù)的另類用法
- ·access制作程序運行進度框
- ·Function與Sub的異同（函數(shù)調(diào)用）
- ·Access判斷某個數(shù)值是否為某個數(shù)據(jù)類型
- ·select case后面語句塊的值的四種格式
- ·vba條件語句的兩種表示方法
- ·Access幾種數(shù)據(jù)類型初始化的值
- ·Access vba null與＂＂空字符串的區(qū)別
- ·access vba 數(shù)據(jù)類型表
- ·Access變量的命名規(guī)則
- ·Access中EXIT Sub與End Sub的區(qū)別
- ·Access vba中參數(shù)前關鍵字ByRef和ByVal
- ·Access列表框快速全選的技巧【最快】
- ·vba函數(shù)的數(shù)據(jù)類型強制轉換
