众大虾,有谁知道人民币大小写转换函数(如1.30-->壹元叁角正)

Question

这是我回复xiaojun2000的,再贴给你吧.
Public Function rmbdx(ByVal data As Double) As String
rmbxx = Mid(Str(data), 2)
dot = InStr(rmbxx, ".")
If dot > 0 Then
  lszs = Left(rmbxx, dot - 1)
  lsxs = Mid(rmbxx, dot + 1, 2)
Else
  lszs = rmbxx
  lsxs = ""
End Ifcd0 = Len(lszs)
dws0 = "元拾佰千万拾佰千亿拾佰千亿"
sh0 = "壹贰叁肆伍陆柒捌玖零"
rmbdx = ""
cd1 = cd0
For I = 1 To cd0
  lspd = Right(lszs, cd1)
  If Val(lspd) = 0 Then
  rmbdx = rmbdx + IIf(cd1 > 4, "万元", "元")
  Exit For
  End If
  ss = Val(Mid(lszs, I, 1))
  If ss <> 0 Then
  rem0 = Mid(sh0, ss, 1) + Mid(dws0, cd1, 1)
  Else
  rem0 = IIf(I <> cd0, "零", "元")
  End If
  rmbdx = rmbdx + rem0
  cd1 = cd1 - 1
Next
Do While InStr(rmbdx, "零零") > 0
  cc = 10 - InStr(rmbdx, "零零")
  rmbdx = Replace(rmbdx, "零零", Mid(dws0, cc, 1), 1, 1)
  rmbdx = Replace(rmbdx, "零零", "零", 1, 1)
  rmbdx = Replace(rmbdx, "零零", "", 1, 1)
Loop
'lsxs = Mid(rmbxx, dot + 1, 2)
If Val(lsxs) <> 0 Then
  ss = Val(Mid(lsxs, 1, 1))
  rem0 = Mid(sh0, ss, 1) + "角"
  rmbdx = rmbdx + rem0
  ss = Val(Mid(lsxs, 2, 1))
  rem0 = IIf(ss = 0, "整", Mid(sh0, ss, 1) + "分")
  rmbdx = rmbdx + rem0
Else
  rmbdx = rmbdx + "整"
End IfEnd Function

Answer 1

Private Sub Command1_Click()
MsgBox NtoC("100200456.45", "点", "", "")
End SubPublic Function NtoC(ByVal sNum 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(4), sUNIT(3), sCents(2) As String
   sBIT(0) = "" '个
   sBIT(1) = "拾"
   sBIT(2) = "佰"
   sBIT(3) = "仟"
   sUNIT(0) = ""
   sUNIT(1) = "万"
   sUNIT(2) = "亿"
   sUNIT(3) = "yu"
   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
             NtoC = NtoC & sUNIT(i - 1)
          End If
       Else
          NtoC = NtoC & sUNIT(i - 1)
       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 Function

Answer 2

Private Sub Command1_Click()
MsgBox NtoC("100200456.45", "元", "角", "分")
End SubPublic Function NtoC(ByVal sNum 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(4), sUNIT(3), sCents(2) As String
  sBIT(0) = "" '个
  sBIT(1) = "拾"
  sBIT(2) = "佰"
  sBIT(3) = "仟"
  sUNIT(0) = ""
  sUNIT(1) = "万"
  sUNIT(2) = "亿"
  sUNIT(3) = "yu"
  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
            NtoC = NtoC & sUNIT(i - 1)
          End If
      Else
          NtoC = NtoC & sUNIT(i - 1)
      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 Function

Answer 3

在http://www.vbforums.net/有完整的例子！

Answer 4

多谢各位的大力支持！！特别是playyuer(女爱㊣)先生按他的方法，把问题摆平了我给 你们加分了！！！！！                    gy