如何把数字转换成大写英文单词

ywin 2003-03-24 05:26:58

有没有函数可用？一定要写代码?

...全文

337 6 打赏收藏转发到动态举报

写回复

用AI写文章

6 条回复

切换为时间正序

请发表友善的回复…

发表回复

ywin 2003-03-27

打赏
举报

one hundred
two hundreds
one thousand
two thousands有没有把这个考虑进去.用自己的方法完成了，事后发觉,单复数没有考虑.

northwolves 2003-03-24

打赏
举报

呵呵，这样：

Function numtotext(ByVal numstr As String) As String

Dim ones, teens, tens, thousands
Dim i As Long, p As Long, nCol As Long, kilo As Boolean
Dim buff As String, temp As String, nChar As String, N As String

ones = Array(" zero ", " one ", " two ", " three ", " four ", " five ", " six ", " seven ", " eight ", " nine ")
teens = Array(" ten ", " eleven ", " twelve ", " thirteen ", " fourteen ", " fifteen ", " sixteen ", " seventeen ", " eighteen ", " nineteen ")
tens = Array("", " ten ", " twenty ", " thirty ", " forty ", " fifty ", " sixty ", " seventy ", " eighty ", " ninety ")
thousands = Array("", " thousand ", " million ", " billion ", " trillion ")
buff = ""

If numstr = "" Then MsgBox "数字为空！！！" & vbCrLf & vbCrLf & "No Number Exists!!!", 64, "警告": Exit Function
If IsNumeric(numstr) = False Then MsgBox "非数字！！！" & vbCrLf & vbCrLf & "Not a Number!!!", 64, "警告": Exit Function
p = IIf(InStr(1, numstr, ".") > 0, InStr(1, numstr, "."), Len(numstr))
If p >= 16 Then MsgBox "转换的数字不得大于一千万亿！！！" & vbCrLf & vbCrLf & "The Number To Be Converted Must Less Than One Thousand Trillion!!!", 64, "警告": Exit Function
N = Left(numstr, p - 1)

For i = p + 1 To Len(numstr)
buff = buff & ones((Mid(numstr, i, 1)))

Next
buff = IIf(buff = "", "", " point " & buff)
For i = Len(N) To 1 Step -1 'Get value of this digit
nChar = Mid(N, i, 1) 'Get column position
nCol = (Len(N) - i) + 1 'Action depends on 1's, 10's or 100's column
Select Case (nCol Mod 3)

Case 1 '1's position
kilo = True
If i = 1 Then
temp = ones(nChar) 'First digit in number (last in loop)

ElseIf Mid(N, i - 1, 1) = "1" Then
temp = teens(nChar): 'This digit is part of "teen" number
i = i - 1 'Skip tens position

ElseIf nChar > 0 Then
temp = ones(nChar) 'Any non-zero digit
Else
kilo = False
'Test for non-zero digit in this grouping
If Mid(N, i - 1, 1) <> "0" Then
kilo = True
ElseIf i > 2 Then
If Mid$(N, i - 2, 1) <> "0" Then kilo = True
temp = ""
End If
End If
'Show "thousands" if non-zero in grouping
If kilo Then buff = temp & IIf(nCol > 1, thousands(nCol \ 3), "") & buff
Case 2 '10's position
If nChar > 0 Then buff = IIf(Mid$(N, i + 1, 1) <> "0", tens(nChar) & "-" & buff, tens(nChar) & buff)

Case 0 '100's position
buff = Switch(nChar > 0, ones(nChar) & " hundred and ", nChar = 0 And nCol <> Len(N), " and ") & buff
End Select
Next i
Do While InStr(1, buff, " and and ") > 0
buff = Replace(buff, " and and ", " and ")
Loop
For i = 1 To 4
buff = Replace(buff, " and " & thousands(i), thousands(i))
Next
buff = Replace(buff, " and point ", " point ")
buff = Replace(buff, " ", " ")
buff = IIf(Right(buff, 4) = "and ", Left(buff, Len(buff) - 4), buff)

numtotext = UCase(buff) 'Return result

End Function

Private Sub Command1_Click()
MsgBox numtotext("123456.789")
End Sub

pcwak 2003-03-24

打赏
举报

Private Sub Command1_Click()
Dim s As String
For i = 1 To Len(Text1.Text)
strint = Mid(Text1.Text, i, 1)
Select Case strint
Case 0
s = s & "A"
Case 1
s = s & "B"
Case 2
s = s & "C"
Case 3
s = s & "D"
Case 4
s = s & "E"
Case 5
s = s & "F"
Case 6
s = s & "G"
Case 7
s = s & "K"
Case 8
s = s & "L"
Case 9
s = s & "X"
End Select
Next i
Text2 = s
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii <> 8 And KeyAscii <> 46) Then KeyAscii = 0
End Sub

落伍者 2003-03-24