# 如何用 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 = "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ"  
    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