[教學] VBA 半型數字字串轉成中文全形

' 將傳進來的半型數字字串轉成中文全形
' -------------------------------------------
Function 轉中文(s As String) As String
  Dim s1 As String
  Dim s2 As Long
  If s = "" Then 轉中文 = "未輸入金額": Exit Function
  While Left(s, 1) = "0": s = Right(s, Len(s) - 1): Wend
  tmp節名 = "元萬億兆京"
  節數 = (Len(s) - 1) \ 4 + 1
  位數 = 節數 * 4
  s = Right("0000" & s, 位數)
  For i = 節數 To 1 Step -1
    個位名 = Mid(tmp節名, i, 1)
    s1 = Mid(s, ((節數 - i) * 4) + 1, 4)
    zero = ""
    If Left(s1, 1) = "0" Then zero = "零"
    tmp = tmp & zero & 轉四位數(s1) & 個位名
  Next
  If Left(tmp, 1) = "零" Then tmp = Right(tmp, Len(tmp) - 1)
  tmp = Replace(tmp, "零零", "零")
  tmp = Replace(tmp, "零萬", "")
  tmp = Replace(tmp, "零億", "")
  tmp = Replace(tmp, "零元", "元")
  轉中文 = tmp & "整"
End Function

Function 轉四位數(s As String) As String
  If s = "0000" Then 轉四位數 = "零": Exit Function
  While Left(s, 1) = "0": s = Right(s, Len(s) - 1): Wend
  s = StrReverse(s)
  tmp位名 = " 拾佰仟"
  tmp中文 = "零壹貳參肆伍陸柒捌玖"
  For i = 1 To Len(s)
    英數字 = Mid(s, i, 1)
    中數字 = Mid(tmp中文, 英數字 + 1, 1)
    位名 = Mid(tmp位名, i, 1): If 英數字 = "0" Then 位名 = ""
    結果 = 中數字 & 位名 & 結果
  Next
  結果 = Replace(結果, "零零零", "零")
  結果 = Replace(結果, "零零", "零")
  If Right(結果, 1) = "零" Then 結果 = Left(結果, Len(結果) - 1)
  轉四位數 = Trim(結果)
End Function

' Private Sub Command1_Click()
'   Debug.Print 轉中文("1234567890123")
'   Debug.Print 轉中文("10003000")
'   Debug.Print 轉中文("1502000")
'   Debug.Print 轉中文("10000000000")
'   Debug.Print 轉中文("100000000000000")
' End Sub


' 將傳進來的英文字串轉成英文全形

Function ChgToAll(Word As String) As String
    Dim WoAll As String
    Dim NewWord As String
    NewWord = ""
    WoAll = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    For i = 1 To Len(Word)
        If Asc(Mid(Word, i, 1)) - 65 >= 0 And Asc(Mid(Word, i, 1)) - 65 <= 25 Then
            NewWord = NewWord + Mid(WoAll, Asc(Mid(Word, i, 1)) - 65 + 1, 1)
        Else
            NewWord = NewWord + Mid(Word, i, 1)
        End If
    Next i

    ChgToAll = NewWord
End Function