lxcc(虫子|专注于抢分) 和northwolves(狼行天下) 接分，问题尚未完全解决，请继续关注

[dut]

原贴：
http://community.csdn.net/Expert/topic/3482/3482703.xml?temp=.3485681

[lxcc]

汗!小数和负数仍然不好解决!可能有些E文地方的数字的读法并不一致!

分给northwolves(狼行天下)吧,我属于蹭分的 :P

[northwolves]

试试还有什么问题：

Function numtotext(ByVal numstr As String) As String
Dim sign 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 Not numstr = "" And Left(numstr, 1) = "-" Then sign = "Negative ": numstr = Mid(numstr, 2)
If IsNumeric(numstr) = False Then MsgBox "非数字！！！" & vbCrLf & vbCrLf & "Not a Number!!!", 64, "警告": Exit Function
If InStr(1, numstr, ".") > 0 Then
p = InStr(1, numstr, ".")
N = Left(numstr, p - 1)
Else
p = Len(numstr)
N = numstr
End If
If p >= 16 Then MsgBox "转换的数字不得大于一千万亿！！！" & vbCrLf & vbCrLf & "The Number To Be Converted Must Less Than One Thousand Trillion!!!", 64, "警告": Exit Function

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, " ", " ")


numtotext = sign & buff 'Return result
Mid(numtotext, 1, 1) = UCase(Mid(numtotext, 1, 1))
End Function

Private Sub Command1_Click()
MsgBox numtotext("-1234567890123.4567890")
End Sub

[northwolves]

上面代码经由网上流行的源代码做了些改动，算法很不怎么样，代码长度应该至少可以缩短到一半。

[dut]

谢谢，先结贴，再测试，还是在原贴讨论吧