关于大写金额，请问大家有谁实现过上亿的数字转换成汉字的实例。

Question

Private Sub Form_Load()
       Text1.MaxLength = 16
       Text1.Text = ""
       Label1.Caption = ""
       Label1.AutoSize = True
       Label1.BorderStyle = 1
  End Sub  Private Sub Text1_Change()
       Label1.Caption = CChinese(Text1.Text)
  End Sub  Private Function CChinese(StrEng As String) As String
       If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Like "*-*" Then
            If Trim(StrEng) <> "" Then MsgBox "無效的數字"
            CChinese = "": Exit Function
       End If
       Dim intLen As Integer, intCounter As Integer
       Dim strCh As String, strTempCh As String
       Dim strSeqCh1 As String, strSeqCh2 As String
       Dim strEng2Ch As String
       strEng2Ch = "零壹貳參肆伍陸柒捌玖"
       strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
       strSeqCh2 = " 萬億兆"
       StrEng = CStr(CDec(StrEng))
       intLen = Len(StrEng)
       For intCounter = 1 To intLen
            strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
            If strTempCh = "零" And intLen <> 1 Then
                 If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
                      strTempCh = ""
                 End If
            Else
                 strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
            End If
            If (intLen - intCounter + 1) Mod 4 = 1 Then
                 strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) \ 4 + 1, 1)
                 If intCounter > 3 Then
                      If Mid(StrEng, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
                End If
            End If
            strCh = strCh & Trim(strTempCh)
       Next
       CChinese = strCh
  End Function

Answer 1

去看我的文档
http://www.csdn.net/develop/read_article.asp?id=14036

Answer 2

最好的代码还是在www.easthot.net

Answer 3

先把要读的数的变量变为字符型。这里用SSS参数是字符型的
Function hjdx(sss As String) As String
Dim s As String
Dim ss As String
Dim s1 As String
Dim s2 As String
Dim n As Integer
Dim i As Integern = InStr(sss, ".")
If n <> 0 Then
   s = Mid(sss, 1, n - 1)
Else
   s = sss
End If
s1 = s
n = Len(s)Do While i < n
   ss = dx01(n - i) '读数
   s = Mid(s1, i + 1, 1)
   
   If (n - i = 1 And Val(s) = 0) Or (Val(s) = 0 And Mid(s1, i + 2, 1) = "0") Then
      '有重复得零，不在读零只读一个零
   Else
      hjdx = hjdx & dx(Val(s)) '读十、百、千位
   End If
   
   If n - i = 9 Or n - i = 5 Then
      If Right(hjdx, 1) = "零" Then
         hjdx = Left(hjdx, Len(hjdx) - 1) '不读零
      End If
   End If
   
   If Val(s) <> 0 Then
      hjdx = hjdx & ss
   End If
   If Right(hjdx, 1) <> "亿" Then '有重复得零，不在读零只读一个零
      hjdx = hjdx & dx02(n - i) '读万、亿位
   End If
  
   
   i = i + 1
Loop'读小数位
hjdx = hjdx & "元"
n = InStr(sss, ".")
If n = 0 Then
   hjdx = hjdx & "整"
Else
   sss = Mid(sss, n + 1)
   s = Mid(sss, 1, 1)
   hjdx = hjdx & dx(Val(s)) & "角"
   s = Mid(sss, 2, 1)
   hjdx = hjdx & dx(Val(s)) & "分"
End IfEnd FunctionFunction dx(number As Integer) As String '将数字转为大写Select Case number
Case 0
 dx = "零"
Case 1
 dx = "壹"
Case 2
 dx = "贰"
Case 3
 dx = "叁"
Case 4
 dx = "肆"
Case 5
 dx = "伍"
Case 6
 dx = "陆"
Case 7
 dx = "柒"
Case 8
 dx = "捌"
Case 9
 dx = "玖"
Case Else
 dx = ""
End SelectEnd Function
Function dx01(number As Integer) As String '确定千位数Select Case number
Case 1
 dx01 = ""
Case 2, 6, 10
 dx01 = "十"
Case 3, 7, 11
 dx01 = "百"
Case 4, 8, 12
 dx01 = "千"
Case Else
 dx01 = ""
End Select
 
End FunctionFunction dx02(number As Integer) As String '确定万、亿位数Select Case number
Case 5
 dx02 = "万"
Case 9
 dx02 = "亿"
Case Else
 dx02 = ""
End Select
 
End FunctionPrivate Sub Text1_GotFocus()
Call AutoSelect(Text1)
End Sub

Answer 4

可无任何长度限制
Option Explicit
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()
VBA.MsgBox NtoC("111111111111111111.97")
End Sub想与大伙共享---将数字转为汉字或汉字货币大写
http://www.csdn.net/Expert/TopicView1.asp?id=918115