小写数字装换大写问题？

Question

我想把小写的数字（包括小数）装换成大写的|我看了JS的例子，在VB里我不会写了？那位高手给我写段代码啊！

Answer 1

Function trans(number As Double) As StringDim x As String, y As String
Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
Const letter = "0123456789sbqwy." '定义汉字缩写Const upcase = "○一二三四五六七八九十百千万亿点" '定义汉字
If Money >= 10 ^ 16 Then MsgBox "数目太大，无法换算！请输入一亿亿以下的数字！", 64, "错误提示": Exit Function '只能转换一亿亿以下的数字！
x = Format(number, "0.00") '格式化数字
y = ""
For i = 1 To Len(x) - 3
y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)
Next
 y = y & Left(Right(x, 2), 1) & Right(x, 1)
y = Replace(y, "0q", "0") '避免○千(如：40200四万○千○二百)
y = Replace(y, "0b", "0") '避免○百(如：41000四万一千○百)
y = Replace(y, "0s", "0") '避免○十(如：204二百○十○四)Do While y <> Replace(y, "00", "0")
y = Replace(y, "00", "0") '避免双○(如：1004一千○○四)
Loop
y = Replace(y, "0y", "y") '避免○亿(如：210亿     二百一十○亿)
y = Replace(y, "0w", "w") '避免○万(如：210万     二百一十○万)
y = IIf(Len(x) = 5 And Left(y, 1) = "1", Right(y, Len(y) - 1), y) '避免一十(如：14一十四；10一十)
For i = 1 To 19
y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '汉字
Next
trans = y
End FunctionPrivate Sub Command1_Click()
MsgBox trans(674548540023.786)
End Sub

Answer 2

UCase Function Example
This example uses the UCase function to return an uppercase version of a string.Dim LowerCase, UpperCase
LowerCase = "Hello World 1234"   ' String to convert.
UpperCase = UCase(LowerCase)   ' Returns "HELLO WORLD 1234".使用UCase函数。

Answer 3

'To ryuginka(ryuginka) :不好意思，小数位没调试好，改一下就好了
'小数转换
'    For i = 1 To Len(num) - dian
     For i = 2 To Len(num) - dian
        currentNum = Val(Mid$(xs, i, 1))
        Label1.Caption = Label1.Caption & numTostr(currentNum)
    Next

Answer 4

Public Function CurrencyChinese(ByVal Number) As String
'将小写金额转换为大写
Dim sNum As String
sNum = CStr(Number)
Const UNITs = ",万,亿,兆,万兆"
Const Yuan = "元"
Const Jiao = "角"
Const Fen = "分"
Const BITs = ",拾,佰,仟"
On Error GoTo er
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
             CurrencyChinese = CurrencyChinese & Choose(Val(Mid(sIntD, J, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") & sBIT(Len(Trim(sIntD)) - J)
          Else
             If Val(Mid(sIntD, J + 1, 1)) <> 0 Then
                CurrencyChinese = CurrencyChinese & "零"
             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
               CurrencyChinese = CurrencyChinese & sUNIT(I - 1)
            End If
         End If
      Else
        CurrencyChinese = CurrencyChinese & sUNIT(I - 1)
      End If
  Next
  If Len(Trim(CurrencyChinese)) > 0 Then
     CurrencyChinese = CurrencyChinese & 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
            CurrencyChinese = CurrencyChinese & Choose(Val(Mid(Trim(sDecD), I, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
            CurrencyChinese = CurrencyChinese & sCents(2 - I)
            If I >= 2 Then
               Exit For
            End If
         Else
            If Len(Trim(CurrencyChinese)) > 0 Then
               CurrencyChinese = CurrencyChinese & "零"
            End If
         End If
     Next I
  Else
     CurrencyChinese = CurrencyChinese & "整"
  End If
Else
  CurrencyChinese = "零" & Yuan
End If
er:
If Err.Number <> 0 Then CurrencyChinese = "#ERROR#"
End Function

Answer 5

数字转换成金钱字.text1内为数字,text2为结果.command1执行.Private Function Num2Str(wsfNum As Double) As String
 Dim TempNum(10) As Long
 Dim TempStr As String
 Dim Temp1 As String
 Dim Temp2 As String
 Dim Temp As String
 Dim Bb As String
Temp1 = "零壹贰叁肆伍陆柒捌玖"
 Temp2 = "亿千百拾万千百拾元角分"
  If wsfNum < 0 Then wsfNum = wsfNum * -1
  wsfNum = Format(wsfNum, "#0.00") * 100
  TempStr = Format(wsfNum, "#00000000000")
  Debug.Print TempStr
   For i& = 0 To 10
    TempNum(i) = Mid$(TempStr, i + 1, 1)
    Temp = Temp + Mid$(Temp1, TempNum(i) + 1, 1) + Mid$(Temp2, i + 1, 1)
   Next i
   Debug.Print Temp
   Dim j As Integer, hehe As String
For i = 1 To Len(Temp) Step 2
If Mid(Temp, i, 1) = "零" Then
j = j + 1
Else
Exit For
End If
Next i
Temp = Right(Temp, Len(Temp) - j * 2)
  Num2Str = Temp
End FunctionPrivate Sub Command1_Click()
    Text2.Text = Num2Str(Text1.Text)
End Sub