如何将将阿拉伯数字转换成“一二三”的汉字数字？

Question

见标题

Answer 1

'*********************************************************
'* 名称：nNumber2Chinese
'* 功能：数值转换为人民币(汉字)
'* 用法：nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
    Dim I, K As Integer
    Dim NC, nd, ka, chrNum, strZheng As String
    Dim c1, c2, c3 As String
    Dim K1 As Integer
    Dim Zheng As String
    Dim Xiao As String
    NC = Trim(Format(txtJE, "##0.00"))
    c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
    c2 = "角分"
    c3 = "玖捌柒陆伍肆叁贰壹"
    If NC = 0 Then
        Num2Chi = "零元整"
        Exit Function
    End If
    Num2Chi = ""
    Zheng = Mid(NC, 1, (Len(NC) - 3))
    Xiao = Mid(NC, (Len(Zheng) + 2))
    If Val(Xiao) <> 0 Then
        For I = Len(Xiao) To 1 Step -1
            chrNum = Mid(Xiao, I, 1)
            If chrNum <> 0 Then
                Num2Chi = Mid(c2, I, 1) & Num2Chi
                Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
            End If
        Next I
    End If
    
    K = 0
    If Val(Zheng) <> 0 Then
        Num2Chi = "元" & Num2Chi
        For I = Len(Zheng) To 1 Step -1
            If (Len(Zheng) - I) = 4 Then
                Num2Chi = "万" & Num2Chi
            ElseIf (Len(Zheng) - I) = 8 Then
                Num2Chi = "亿" & Num2Chi
            ElseIf (Len(Zheng) - I) = 12 Then
                Num2Chi = "万" & Num2Chi
            End If
            chrNum = Mid(Zheng, I, 1)
            If chrNum <> 0 Then
                If I = Len(Zheng) Then
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                Else
                    If (Len(Zheng) - I) <> 4 And (Len(Zheng) - I) <> 8 And (Len(Zheng) - I) <> 12 Then
                        Num2Chi = Mid(c1, (Len(c1) - K), 1) & Num2Chi
                    End If
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                End If
            Else
                If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
                    If Mid(Num2Chi, 1, 1) <> "零" Then
                        Num2Chi = "零" & Num2Chi
                    End If
                End If
           End If
            K = K + 1
        Next I
    End If
    If Right(Trim(Num2Chi), 1) <> "分" Then
        Num2Chi = Num2Chi & "整"
    End If
End Function

Answer 2

Public Function NtoC(ByVal sNum As String, Optional BITs As String = ",拾,佰,仟", Optional UNITs As String = ",[万],[亿],[兆],[万兆]", Optional ByVal Yuan As String = "美圆", Optional ByVal Jiao As String = "美角", Optional ByVal Fen As String = "美分") As String
If Val(Trim(sNum)) > 0 Then
  Dim sIntD, sDecD As String
  Dim i, iCount, j, iLength As Integer
  Dim lStartPos As Long
  Dim sBIT() As String
  Dim sUNIT() As String
  Dim sCents(2) As String
  sBIT = VBA.Split(BITs, ",")
  sUNIT = VBA.Split(UNITs, ",")
  sCents(0) = Fen
  sCents(1) = Jiao
  Dim temp As String
  If InStr(Trim(sNum), ".") > 0 Then
     temp = Left(Trim(sNum), InStr(Trim(sNum), ".") - 1)
  Else
     temp = Trim(sNum)
  End If
  iCount = IIf(Len(temp) Mod 4, Len(Trim(temp)) \ 4 + 1, Len(Trim(temp)) \ 4)
  lStartPos = 1
  For i = iCount To 1 Step -1
      If i = iCount And Len(Trim(temp)) Mod 4 <> 0 Then
         iLength = Len(Trim(temp)) Mod 4
      Else
         iLength = 4
      End If
      sIntD = Mid(Trim(temp), lStartPos, iLength)
      For j = 1 To Len(Trim(sIntD))
          If Val(Mid(sIntD, j, 1)) <> 0 Then
             NtoC = NtoC & Choose(Val(Mid(sIntD, j, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") & sBIT(Len(Trim(sIntD)) - j)
          Else
             If Val(Mid(sIntD, j + 1, 1)) <> 0 Then
                NtoC = NtoC & "零"
             End If
          End If
      Next j
      lStartPos = lStartPos + iLength
      If i < iCount Then
         If (Val(Mid(sIntD, Len(Trim(sIntD)), 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 1, 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 2, 1)) Or Val(Mid(sIntD, Len(Trim(sIntD)) - 3, 1)) <> 0) Then
            If i < UBound(sUNIT) + 1 Then
               NtoC = NtoC & sUNIT(i - 1)
            'Else
            '   NtoC = NtoC & sUNIT(i - 1)
            End If
         End If
      Else
         'If i < UBound(sUNIT) + 1 Then
            NtoC = NtoC & sUNIT(i - 1)
         'End If
      End If
  Next
  If Len(Trim(NtoC)) > 0 Then
     NtoC = NtoC & Yuan
  End If
  '小数
  If InStr(1, Trim(sNum), ".") <> 0 Then
     sDecD = Right(sNum, Len(Trim(sNum)) - InStr(1, Trim(sNum), "."))
     For i = 1 To Len(Trim(sDecD))
         If Val(Mid(Trim(sDecD), i, 1)) <> 0 Then
            NtoC = NtoC & Choose(Val(Mid(Trim(sDecD), i, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
            NtoC = NtoC & sCents(2 - i)
            If i >= 2 Then
               Exit For
            End If
         Else
            If Len(Trim(NtoC)) > 0 Then
               NtoC = NtoC & "零"
            End If
         End If
     Next i
  Else
     NtoC = NtoC & "整"
  End If
Else
  NtoC = "零" & Yuan
End If
End FunctionPrivate Sub Command1_Click()
    MsgBox NtoC(Text1.text)
End Sub

Answer 3

Public Function NtoC(ByVal sNum As String, Optional BITs As String = ",十,百,千", Optional UNITs As String = ",[万],[亿],[兆],[万兆]", Optional ByVal Yuan As String = "圆", Optional ByVal Jiao As String = "角", Optional ByVal Fen As String = "分") As String
If Val(Trim(sNum)) > 0 Then
  Dim sIntD, sDecD As String
  Dim i, iCount, j, iLength As Integer
  Dim lStartPos As Long
  Dim sBIT() As String
  Dim sUNIT() As String
  Dim sCents(2) As String
  sBIT = VBA.Split(BITs, ",")
  sUNIT = VBA.Split(UNITs, ",")
  sCents(0) = Fen
  sCents(1) = Jiao
  Dim temp As String
  If InStr(Trim(sNum), ".") > 0 Then
     temp = Left(Trim(sNum), InStr(Trim(sNum), ".") - 1)
  Else
     temp = Trim(sNum)
  End If
  iCount = IIf(Len(temp) Mod 4, Len(Trim(temp)) \ 4 + 1, Len(Trim(temp)) \ 4)
  lStartPos = 1
  For i = iCount To 1 Step -1
      If i = iCount And Len(Trim(temp)) Mod 4 <> 0 Then
         iLength = Len(Trim(temp)) Mod 4
      Else
         iLength = 4
      End If
      sIntD = Mid(Trim(temp), lStartPos, iLength)
      For j = 1 To Len(Trim(sIntD))
          If Val(Mid(sIntD, j, 1)) <> 0 Then
             NtoC = NtoC & Choose(Val(Mid(sIntD, j, 1)), "一", "二", "三", "四", "五", "六", "七", "八", "九") & sBIT(Len(Trim(sIntD)) - j)
          Else
             If Val(Mid(sIntD, j + 1, 1)) <> 0 Then
                NtoC = NtoC & "零"
             End If
          End If
      Next j
      lStartPos = lStartPos + iLength
      If i < iCount Then
         If (Val(Mid(sIntD, Len(Trim(sIntD)), 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 1, 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 2, 1)) Or Val(Mid(sIntD, Len(Trim(sIntD)) - 3, 1)) <> 0) Then
            If i < UBound(sUNIT) + 1 Then
               NtoC = NtoC & sUNIT(i - 1)
            'Else
            '   NtoC = NtoC & sUNIT(i - 1)
            End If
         End If
      Else
         'If i < UBound(sUNIT) + 1 Then
            NtoC = NtoC & sUNIT(i - 1)
         'End If
      End If
  Next
  If Len(Trim(NtoC)) > 0 Then
     NtoC = NtoC & Yuan
  End If
  '小数
  If InStr(1, Trim(sNum), ".") <> 0 Then
     sDecD = Right(sNum, Len(Trim(sNum)) - InStr(1, Trim(sNum), "."))
     For i = 1 To Len(Trim(sDecD))
         If Val(Mid(Trim(sDecD), i, 1)) <> 0 Then
            NtoC = NtoC & Choose(Val(Mid(Trim(sDecD), i, 1)), "一", "二", "三", "四", "五", "六", "七", "八", "九")
            NtoC = NtoC & sCents(2 - i)
            If i >= 2 Then
               Exit For
            End If
         Else
            If Len(Trim(NtoC)) > 0 Then
               NtoC = NtoC & "零"
            End If
         End If
     Next i
  Else
     NtoC = NtoC & "整"
  End If
Else
  NtoC = "零" & Yuan
End If
End FunctionPrivate Sub Command2_Click()
    MsgBox NtoC("111111111111111111.97")
End Sub

Answer 4

'以前写的一个程序
'将数字转换成中文字符
Private Function convert(m As String) As String    Dim a, b, c, d, e, f As Integer
    Dim money As Single
    Dim character(9) As String
    
    character(0) = "零"
    character(1) = "壹"
    character(2) = "贰"
    character(3) = "叁"
    character(4) = "肆"
    character(5) = "伍"
    character(6) = "陆"
    character(7) = "柒"
    character(8) = "捌"
    character(9) = "玖"
    
    '取每位数字
    money = Round(m, 2)
    a = Int(money / 1000)
    b = Int((money - a * 1000) / 100)
    c = Int((money - a * 1000 - b * 100) / 10)
    d = Int(money - a * 1000 - b * 100 - c * 10)
    '要扩大十倍才能算出其值，否则出现过多的小数位
    e = Int(money * 10 - a * 10000 - b * 1000 - c * 100 - d * 10)
    f = Int(money * 100 - a * 100000 - b * 10000 - c * 1000 - d * 100 - e * 10)
    '不能按以下计算，如 0.7会计算为0.69969
    'e = Int((money - a * 1000 - b * 100 - c * 10 - d) * 10)
    'f = Int((money - a * 1000 - b * 100 - c * 10 - d - e / 10) * 100)
    convert = character(a) + "  " + character(b) + "   " + character(c) + "  " + character(d) + "   " + character(e) + "   " + character(f)
End Function