Private Sub Command1_Click()
Dim lon As Long
Dim ll As Long
Dim number As Long
Dim Bn() As Variant
Dim An() As Variant
Dim isO As Long
Bn() = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
An() = Array("", "拾", "佰", "仟", "万", "拾", "佰", "仟")
If Val(Text1.Text) >= 10000000 Then
MsgBox "暂时不能换超过仟万位"
Exit Sub
End If
number = Val(Text1.Text)
lon = 1
ll = 1
While number >= 10
number = number / 10
lon = lon + 1
ll = ll * 10
Wend
number = Val(Text1.Text)
Text2 = ""
For i = 1 To lon
If (number \ ll) <> 0 Then
Text2 = Text2 & Bn(number \ ll)
Text2 = Text2 & An(lon - i)
isO = 1
Else
If isO = 1 Then
If (lon - i) Mod 4 = 0 Then
If Right(Text2, 1) = "零" Then
Text2 = Left(Text2, Len(Text2.Text) - 1) & An(lon - i)
isO = 1
End If
Else
Text2 = Text2 & Bn(number \ ll)
isO = 0
End If
Else
If (lon - i) Mod 4 = 0 Then
If Right(Text2, 1) = "零" Then
Text2 = Left(Text2, Len(Text2.Text) - 1) & An(lon - i)
isO = 1
End If
End If
End If
End If
number = number Mod ll
ll = ll / 10
Next i
End Sub
(不明白Q我)