求数字转换成英文大写,在线等

Question

求数字转换成英文大写,在线等

Answer 1

1-> ONE
2-> TWO
?? 不大懂

Answer 2

查看ASCII码表，转换时相应的加减其值

Answer 3

dim i
for i=97 to 122
    debug.print StrConv(Chr(i), vbProperCase);
next 这个？

Answer 4

楼主的要求是把一个阿拉伯数字转换成英文，例如1234 -> one thousand two hundred and thirty four。

Answer 5

大概是这样：Public Function Number2Word(ByVal x As Integer) As String
Dim Ones(1 To 19) As String
Dim Tens(2 To 9) As String
Dim tmp As Integer
Dim myWords As String  If x > 999 Then Exit Function  Ones(1) = "ONE"
  Ones(2) = "TWO"
  Ones(3) = "THREE"
  Ones(4) = "FOUR"
  Ones(5) = "FIVE"
  Ones(6) = "SIX"
  Ones(7) = "SEVEN"
  Ones(8) = "EIGHT"
  Ones(9) = "NINE"
  Ones(10) = "TEN"
  Ones(11) = "ELEVEN"
  Ones(12) = "TWELVE"
  Ones(13) = "THIRTEEN"
  Ones(14) = "FOURTEEN"
  Ones(15) = "FIFTEEN"
  Ones(16) = "SIXTEEN"
  Ones(17) = "SEVENTEEN"
  Ones(12) = "EIGHTEEN"
  Ones(19) = "NINETEEN"  Tens(2) = "TWENTY"
  Tens(3) = "THIRTY"
  Tens(4) = "FORTY"
  Tens(5) = "FIFTY"
  Tens(6) = "SIXTY"
  Tens(7) = "SEVENTY"
  Tens(8) = "EIGHTY"
  Tens(9) = "NINETY"  tmp = x \ 100
  If tmp Then
    myWords = Ones(tmp) & " HUNDRED"
  End If  tmp = x Mod 100
  If tmp < 20 Then
    myWords = IIf(myWords > "", myWords & " AND ", "") & Ones(tmp)
  Else
    tmp = tmp \ 10
    myWords = IIf(myWords > "", myWords & " AND ", "") & Tens(tmp)
    tmp = x Mod 10
    If tmp Then myWords = IIf(myWords > "", myWords & " ", "") & Ones(tmp)
  End If
  Number2Word = myWords
End FunctionPublic Function BigNumber2Word(ByVal x As Long) As String
Dim tmp As Long
Dim myWords As String  If x > 999999999 Then Exit Function
  tmp = x \ 1000000
  If tmp Then
    myWords = Number2Word(tmp) & " MILLION"
  End If  tmp = x Mod 1000000
  If tmp Then
    tmp = tmp \ 1000
    If tmp Then
        myWords = IIf(myWords > "", myWords & " ", "") & Number2Word(tmp) & " THOUNSAND"
    End If
    
    tmp = x Mod 1000
    If tmp Then
        myWords = IIf(myWords > "", myWords & " ", "") & Number2Word(tmp)
    End If
  End If
  BigNumber2Word = myWords
End Function

Answer 6

'Form1,Height 为10020，Width 为6630，ScaleMode设为1-Twip
'添加一个Label1,Index设为0
'添加一个Text1,Index设为0
'添加一个Command1,放在Form1的最低端
Option Explicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright &#129;0&#8222;81996-2006 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Module Name:   NumberAsText
'Programmer:    Frederick Rothstein
'Date Released: May 16, 1999
'Date Modified: August 20, 1999
'Copyright 1999 by Frederick N. Rothstein (All rights reserved)
      'array to hold the various textual
'representations of a number
Private sNumberText() As StringPrivate Sub Form_Load()   Dim cnt As Long
   Dim nTop As Long
   Dim nWidth As Long
   
   For cnt = 0 To 24 '25 controls
   
      If cnt > 0 Then
         Load Text1(cnt)
         Load Label1(cnt)
      End If
      
      With Label1(cnt)
      
         .AutoSize = True
         .Move 200, (300 * cnt) + nTop
         
         Select Case cnt
            Case 0, 5, 10, 15, 20
               .Visible = False
               
            Case 1, 6, 11, 16, 21
               .Caption = "No Format"
               .Visible = True            Case 2, 7, 12, 17, 22
               .Caption = "'And'"
               .Visible = True
            Case 3, 8, 13, 18, 23
               .Caption = "'Check'"
               .Visible = True
               
            Case 4, 9, 14, 19, 24
               .Caption = "'Dollar'"
               .Visible = True
               
         End Select
      End With  'Label1
                  
      nWidth = 1200
      
      With Text1(cnt)
      
         Select Case cnt
            Case 0
               .Text = "342.79"
               nTop = nTop + 200
            Case 5
               .Text = "1.14"
               nTop = nTop + 200
            Case 10
               .Text = "1.9950072"
               nTop = nTop + 200
            Case 15
               .Text = "+11432"
               nTop = nTop + 200
            Case 20
               .Text = "-81131"
               nTop = nTop + 200
            Case Else
               .Text = ""
               nWidth = 5000
         End Select        .Move 1200, (300 * cnt) + nTop, nWidth
        .Visible = True
         
      End With  'Text1   Next cnt
   
   With Command1
      .Caption = "Convert"
      .Move 1200, Text1(24).Top + Text1(24).Height + 200, 1500
   End With
   
  'preload sNumberText() with
  'strings representing the possible
  'textual representations of a number
   Call BuildArray(sNumberText)
   
End Sub
     
      
Private Sub Command1_Click()   Dim value As String   value = Text1(0).Text
   Text1(1).Text = NumberAsText(value, "")
   Text1(2).Text = NumberAsText(value, "and")
   Text1(3).Text = NumberAsText(value, "check")
   Text1(4).Text = NumberAsText(value, "dollar")   value = Text1(5).Text
   Text1(6).Text = NumberAsText(value, "")
   Text1(7).Text = NumberAsText(value, "and")
   Text1(8).Text = NumberAsText(value, "check")
   Text1(9).Text = NumberAsText(value, "dollar")   value = Text1(10).Text
   Text1(11).Text = NumberAsText(value, "")
   Text1(12).Text = NumberAsText(value, "and")
   Text1(13).Text = NumberAsText(value, "check")
   Text1(14).Text = NumberAsText(value, "dollar")   value = Text1(15).Text
   Text1(16).Text = NumberAsText(value, "")
   Text1(17).Text = NumberAsText(value, "and")
   Text1(18).Text = NumberAsText(value, "check")
   Text1(19).Text = NumberAsText(value, "dollar")   value = Text1(20).Text
   Text1(21).Text = NumberAsText(value, "")
   Text1(22).Text = NumberAsText(value, "and")
   Text1(23).Text = NumberAsText(value, "check")
   Text1(24).Text = NumberAsText(value, "dollar")
End Sub
Private Sub BuildArray(sNumberText() As String)   ReDim sNumberText(0 To 27) As String
 
   sNumberText(0) = "Zero"
   sNumberText(1) = "One"
   sNumberText(2) = "Two"
   sNumberText(3) = "Three"
   sNumberText(4) = "Four"
   sNumberText(5) = "Five"
   sNumberText(6) = "Six"
   sNumberText(7) = "Seven"
   sNumberText(8) = "Eight"
   sNumberText(9) = "Nine"
   sNumberText(10) = "Ten"
   sNumberText(11) = "Eleven"
   sNumberText(12) = "Twelve"
   sNumberText(13) = "Thirteen"
   sNumberText(14) = "Fourteen"
   sNumberText(15) = "Fifteen"
   sNumberText(16) = "Sixteen"
   sNumberText(17) = "Seventeen"
   sNumberText(18) = "Eighteen"
   sNumberText(19) = "Nineteen"
   sNumberText(20) = "Twenty"
   sNumberText(21) = "Thirty"
   sNumberText(22) = "Forty"
   sNumberText(23) = "Fifty"
   sNumberText(24) = "Sixty"
   sNumberText(25) = "Seventy"
   sNumberText(26) = "Eighty"
   sNumberText(27) = "Ninety"
   
End Sub
Private Function IsBounded(vntArray As Variant) As Boolean
 
  'note: the application in the IDE will stop
  'at this line when first run if the IDE error
  'mode is not set to "Break on Unhandled Errors"
  '(Tools/Options/General/Error Trapping)
   On Error Resume Next
   IsBounded = IsNumeric(UBound(vntArray))
   
End Function
Private Function HundredsTensUnits(ByVal TestValue As Integer, _
                                   Optional bUseAnd As Boolean) As String   Dim CardinalNumber As Integer
    
   If TestValue > 99 Then
      CardinalNumber = TestValue \ 100
      HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
      TestValue = TestValue - (CardinalNumber * 100)
   End If
    
   If bUseAnd = True Then
      HundredsTensUnits = HundredsTensUnits & "and "
   End If
   
   If TestValue > 20 Then
      CardinalNumber = TestValue \ 10
      HundredsTensUnits = HundredsTensUnits & _
                          sNumberText(CardinalNumber + 18) & " "
      TestValue = TestValue - (CardinalNumber * 10)
   End If
    
   If TestValue > 0 Then
      HundredsTensUnits = HundredsTensUnits & sNumberText(TestValue) & " "
   End IfEnd Function

Answer 7

Private Function NumberAsText(NumberIn As Variant, _
                              Optional AND_or_CHECK_or_DOLLAR As String) As String
   Dim cnt As Long
   Dim DecimalPoint As Long
   Dim CardinalNumber As Long
   Dim CommaAdjuster As Long
   Dim TestValue As Long
   Dim CurrValue As Currency
   Dim CentsString As String
   Dim NumberSign As String
   Dim WholePart As String
   Dim BigWholePart As String
   Dim DecimalPart As String
   Dim tmp As String
   Dim sStyle As String
   Dim bUseAnd As Boolean
   Dim bUseCheck As Boolean
   Dim bUseDollars As Boolean
   
   
  '----------------------------------------
  'Begin setting conditions for formatting
  '----------------------------------------
  
  'Determine whether to apply special formatting.
  'If nothing passed, return routine result
  'converted only into its numeric equivalents,
  'with no additional format text.
   sStyle = LCase(AND_or_CHECK_or_DOLLAR)  'User passed "AND": "and" will be added
  'between hundredths and tens of dollars,
  'ie "Three Hundred and Forty Two"
   bUseAnd = sStyle = "and"
   
  'User passed "DOLLAR": "dollar(s)" and "cents"
  'appended to string,
  'ie "Three Hundred and Forty Two Dollars"
   bUseDollars = sStyle = "dollar"
   
  'User passed "CHECK" *or* "DOLLAR"
  'If "check", cent amount returned as a fraction /100
  'i.e. "Three Hundred Forty Two and 00/100"
  'If "dollar" was passed, "dollar(s)" and "cents"
  'appended instead.
   bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
    
    
  '----------------------------------------
  'Check/create array. If this is the first
  'time using this routine, create the text
  'strings that will be used.
  '----------------------------------------
   If Not IsBounded(sNumberText) Then
      Call BuildArray(sNumberText)
   End If
     
  '----------------------------------------
  'Begin validating the number, and breaking
  'into constituent parts
  '----------------------------------------
  
  'prepare to check for valid value in
   NumberIn = Trim$(NumberIn)
   
   If Not IsNumeric(NumberIn) Then     'invalid entry - abort
      NumberAsText = "Error - Number improperly formed"
      Exit Function   Else     'decimal check
      DecimalPoint = InStr(NumberIn, ".")      If DecimalPoint > 0 Then        'split the fractional and primary numbers
         DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
         WholePart = Left$(NumberIn, DecimalPoint - 1)      Else
      
        'assume the decimal is the last char
         DecimalPoint = Len(NumberIn) + 1
         WholePart = NumberIn
         
      End If      If InStr(NumberIn, ",,") Or _
         InStr(NumberIn, ",.") Or _
         InStr(NumberIn, ".,") Or _
         InStr(DecimalPart, ",") Then         NumberAsText = "Error - Improper use of commas"
         Exit Function      ElseIf InStr(NumberIn, ",") Then         CommaAdjuster = 0
         WholePart = ""         For cnt = DecimalPoint - 1 To 1 Step -1            If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then               WholePart = Mid$(NumberIn, cnt, 1) & WholePart            Else               CommaAdjuster = CommaAdjuster + 1               If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then                  NumberAsText = "Error - Improper use of commas"
                  Exit Function               End If 'If
            End If  'If Not
         Next  'For cnt
      End If  'If InStr
   End If  'If Not    
   If Left$(WholePart, 1) Like "[+-]" Then
      NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
      WholePart = Mid$(WholePart, 2)
   End If   
  '----------------------------------------
  'Begin code to assure decimal portion of
  'check value is not inadvertently rounded
  '----------------------------------------
   If bUseCheck = True Then
   
      CurrValue = CCur(Val("." & DecimalPart))
      DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
      
      If CurrValue >= 0.995 Then
         
         If WholePart = String$(Len(WholePart), "9") Then
            
            WholePart = "1" & String$(Len(WholePart), "0")
               
         Else
               
            For cnt = Len(WholePart) To 1 Step -1
            
              If Mid$(WholePart, cnt, 1) = "9" Then
                 Mid$(WholePart, cnt, 1) = "0"
              Else
                 Mid$(WholePart, cnt, 1) = CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
                 Exit For
              End If
               
            Next
         
         End If  'If WholePart
      End If  'If CurrValue
   End If  'If bUseCheck
    
  '----------------------------------------
  'Final prep step - this assures number
  'within range of formatting code below
  '----------------------------------------
   If Len(WholePart) > 9 Then
      BigWholePart = Left$(WholePart, Len(WholePart) - 9)
      WholePart = Right$(WholePart, 9)
   End If
    
   If Len(BigWholePart) > 9 Then
   
      NumberAsText = "Error - Number too large"
      Exit Function
       
   ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
         (Not BigWholePart Like String$(Len(BigWholePart), "#") _
          And Len(BigWholePart) > 0) Then
          
      NumberAsText = "Error - Number improperly formed"
      Exit Function
     
   End If  '----------------------------------------
  'Begin creating the output string
  '----------------------------------------
    
  'Very Large values
   TestValue = Val(BigWholePart)
    
   If TestValue > 999999 Then
      CardinalNumber = TestValue \ 1000000
      tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
      TestValue = TestValue - (CardinalNumber * 1000000)
   End If
   
   If TestValue > 999 Then
     CardinalNumber = TestValue \ 1000
     tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
     TestValue = TestValue - (CardinalNumber * 1000)
   End If
   
   If TestValue > 0 Then
      tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
   End If
   
  'Lesser values
   TestValue = Val(WholePart)
   
   If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
   
   If TestValue > 999999 Then
      CardinalNumber = TestValue \ 1000000
      tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
      TestValue = TestValue - (CardinalNumber * 1000000)
   End If
    
   If TestValue > 999 Then
      CardinalNumber = TestValue \ 1000
      tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
      TestValue = TestValue - (CardinalNumber * 1000)
   End If
    
   If TestValue > 0 Then
      If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
      tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
   End If
    
  'If in dollar mode, assure the text is the correct plurality
   If bUseDollars = True Then
    
      CentsString = HundredsTensUnits(DecimalPart)
      
      If tmp = "One " Then
         tmp = tmp & "Dollar"
      Else
         tmp = tmp & "Dollars"
      End If
      
      If Len(CentsString) > 0 Then
         
         tmp = tmp & " and " & CentsString
        
         If CentsString = "One " Then
            tmp = tmp & "Cent"
         Else
            tmp = tmp & "Cents"
         End If
      
      End If
      
   ElseIf bUseCheck = True Then
      
      tmp = tmp & "and " & Left$(DecimalPart & "00", 2)
      tmp = tmp & "/100"
    
   Else
    
      If Len(DecimalPart) > 0 Then
        
        tmp = tmp & "Point"
        
        For cnt = 1 To Len(DecimalPart)
          tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
        Next
      
      End If  'If DecimalPart
   End If   'If bUseDollars
    
    
  'done!
   NumberAsText = NumberSign & tmp
    
End Function

Answer 8

这段带码很Flexible,可以读数字（number)或Amount of Currency in English.
good Luck!

Answer 9

李开复说：
“算法就是力量；算法就是一切。”to 2004kingbear() :
你自己测试一下吧。

Answer 10

要求整数和小数都可以转换,代码简单易懂整数和小数都可以转换，yeah!你Test吗？在叫什么？！！！再叫打你头啦。呵呵。

Answer 11

晕 有那么麻烦么！！
replace 转换函数不就可以咯！！
请LZ 和我做例题exe内包含 2个 控件 text1 *1  command1*1代码：
Private Sub Command1_Click()
Text1 = Replace(Text1, "1", "One ")
Text1 = Replace(Text1, "2", "Two ")
Text1 = Replace(Text1, "3", "three ")
Text1 = Replace(Text1, "4", "four ")
Text1 = Replace(Text1, "5", "file ")
Text1 = Replace(Text1, "6", "six ")
Text1 = Replace(Text1, "7", "seven ")
Text1 = Replace(Text1, "8", "eight ")
Text1 = Replace(Text1, "9", "nine ")
Text1 = Replace(Text1, "0", "zero ")
end sub 程序效果 在text1内输入的数字 全部变成英文  现在明白了吧！ 可以根据自己需要修改上面底码[不知道英文写对了没...]  比如LZ 说的 数字转英文大写  改上面英文就OK了  给分！！给分！！*******************************
cike技术交流群 16874787

Answer 12

你只有一个山峰（金字塔 or 三角形),信 誉 值倒降到74分。Reply off line.不再回答你的贴了。

Answer 13

LZ到哪去了？还没结帖。
LZ问题解决了吗？没解决，告诉大家一声，大家再帮你想。

Answer 14

那么简单的问题都需要那么多代码, Text1 = Replace(Text1, "7", "TS ")
不就解决了!