|
Function RMB(x As Double) As String
Dim i1 As Long, i2 As Long, j As Long, m As Long, strm(15) As String
Dim strB1 As String, strB2 As String
RMB = str(Round(x, 4))
j = InStr(1, RMB, ".", 1)
If j = 0 Then
strB1 = Trim(RMB)
strB2 = ""
Else
strB1 = Trim(Mid(RMB, 1, j - 1))
strB2 = Trim(Mid(RMB, j + 1, 4))
End If
strB1 = Replace(Replace(Replace(Replace(Replace(strB1, "0", "零"), "1", "壹"), "2", "貳"), "3", "叁"), "4", "肆")
strB1 = Replace(Replace(Replace(Replace(Replace(strB1, "5", "伍"), "6", "陆"), "7", "柒"), "8", "捌"), "9", "玖")
strB2 = Replace(Replace(Replace(Replace(Replace(strB2, "0", "零"), "1", "壹"), "2", "貳"), "3", "叁"), "4", "肆")
strB2 = Replace(Replace(Replace(Replace(Replace(strB2, "5", "伍"), "6", "陆"), "7", "柒"), "8", "捌"), "9", "玖")
i1 = Len(strB1): i2 = Len(strB2)
For j = 1 To i1
strm(j) = Mid(strB1, i1 - j + 1, 1)
Next
strB1 = ""
For j = 1 To i1
Select Case j
Case 1
If strm(j) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Case 2
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "拾" & strB1
End If
Case 3
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "佰" & strB1
End If
Case 4
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "仟" & strB1
End If
Case 5
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
If strm(j) = "零" And strm(j + 1) = "零" And strm(j + 2) = "零" And strm(j + 3) = "零" Then
strB1 = strB1
Else
strB1 = "万" & strB1
End If
Else
strB1 = strm(j) & "万" & strB1
End If
Else
strB1 = strm(j) & "万" & strB1
End If
Case 6
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "拾" & strB1
End If
Case 7
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "佰" & strB1
End If
Case 8
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "仟" & strB1
End If
Case 9
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
If strm(j) = "零" And strm(j + 1) = "零" And strm(j + 2) = "零" And strm(j + 3) = "零" Then
strB1 = strB1
Else
strB1 = "亿" & strB1
End If
Else
strB1 = strm(j) & "亿" & strB1
End If
Else
strB1 = strm(j) & "亿" & strB1
End If
Case 10
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "拾" & strB1
End If
Case 11
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "佰" & strB1
End If
Case 12
If strm(j) = "零" Then
If strm(j - 1) = "零" Then
strB1 = strB1
Else
strB1 = strm(j) & strB1
End If
Else
strB1 = strm(j) & "仟" & strB1
End If
End Select
Next
Select Case i2
Case 0
strB2 = "整"
Case 1
strB2 = Mid(strB2, 1, 1) & "角" & "零分"
Case 2
strB2 = Mid(strB2, 1, 1) & "角" & Mid(strB2, 2, 1) & "分"
Case 3
strB2 = Mid(strB2, 1, 1) & "角" & Mid(strB2, 2, 1) & "分" & Mid(strB2, 3, 1) & "厘"
Case 4
strB2 = Mid(strB2, 1, 1) & "角" & Mid(strB2, 2, 1) & "分" & Mid(strB2, 3, 1) & "厘" & Mid(strB2, 4, 1) & "毫"
End Select
strB1 = strB1 & IIf(i1 = 0, "", "元")
If RMB = "0" Then
RMB = ""
Else
RMB = strB1 & strB2
End If
End Function |
|