我正在写，写好发给你。QQ394901158
写好了，是大写转小写的，以下是代码
Public b(1 To 12) As Integer
Const dx = "壹贰叁肆伍陆柒捌玖"
Sub 转换()
Dim strtemp As String, yi As String, wang As String, jie As String
Dim 第一个不为零 As Boolean, i As Integer, j As Integer, m As Integer
Const fj = "亿万元"
For i = 1 To 12
b(i) = 0
Next i
Sheets("sheet1").Range("K7:V7").ClearContents
strtemp = Sheets("sheet1").Cells(6, 2)
For i = 1 To Len(fj)
If InStr(1, strtemp, Mid(fj, i, 1)) <> 0 Then
a = InStr(1, strtemp, Mid(fj, i, 1))
Call 分解(Left(strtemp, a - 1), i)
strtemp = Right(strtemp, Len(strtemp) - a)
End If
Next i
Const fjj = "角分"
For j = 1 To Len(fjj)
If InStr(1, strtemp, Mid(fjj, j, 1)) <> 0 Then
a = InStr(1, strtemp, Mid(fjj, j, 1))
b(10 + j) = InStr(1, dx, Left(strtemp, 1))
strtemp = Right(strtemp, Len(strtemp) - a)
End If
Next j
For m = 1 To 12
If 第一个不为零 = False And b(m) >= 1 Then
第一个不为零 = True
Sheets("sheet1").Cells(7, 9 + m) = "￥"
Sheets("sheet1").Cells(7, 10 + m) = b(m)
ElseIf 第一个不为零 Then
Sheets("sheet1").Cells(7, 10 + m) = b(m)
End If
Next m
End Sub
Function 分解(strtemp As String, jie As Integer)
Const fj = "千百拾"
Dim se As String '数额
Dim s_Num As Integer
For i = 1 To Len(fj)
If InStr(1, strtemp, Mid(fj, i, 1)) <> 0 Then
a = InStr(1, strtemp, Mid(fj, i, 1))
se = Left(strtemp, a - 1)
If se = "" Then se = "壹"
If Len(se) > 1 Then
s_Num = InStr(1, dx, Right(se, 1))
Else
s_Num = InStr(1, dx, se)
End If
If jie = 1 Then
b(i - 2) = s_Num
ElseIf jie = 2 Then
b(i + 2) = s_Num
ElseIf jie = 3 Then
b(i + 6) = s_Num
End If
strtemp = Right(strtemp, Len(strtemp) - a)
If strtemp = "" Then Exit Function
End If
Next i
If Len(strtemp) = 2 Then
If jie = 1 Then
b(2) = InStr(1, dx, Right(strtemp, 1))
ElseIf jie = 2 Then
b(6) = InStr(1, dx, Right(strtemp, 1))
Else
b(10) = InStr(1, dx, Right(strtemp, 1))
End If
ElseIf Len(strtemp) = 1 Then
If jie = 1 Then
b(2) = InStr(1, dx, strtemp)
ElseIf jie = 2 Then
b(6) = InStr(1, dx, strtemp)
Else
b(10) = InStr(1, dx, strtemp)
End If
End If
End Function
在B7单元格输入大写的金额，回车后，在小写框中会自动转换过来。
注意大写的数字必须是“壹贰叁肆伍陆柒捌玖”中的文字，比如：伍拾，不能写成五拾。“亿万千百拾”不能是“亿万仟佰拾”。
