VBA 如何将数字转换为中文大写

Posted 2023-05-03

大意如题！

Public Function 中文大写(数字 As Currency) As String
Dim a As Variant, b As Integer, c As Integer
Dim q(1 To 9) As String, s1 As Variant
q(1) = "壹": q(2) = "贰": q(3) = "叁": q(4) = "肆"
q(5) = "伍": q(6) = "陆": q(7) = "柒": q(8) = "捌": q(9) = "玖"
a = Int(数字)
b = Val(Mid(Str(数字), InStr(1, Str(数字), ".") + 1, 1))
c = Val(Right(Application.Text(Str(数字 * 100), "0"), 1))
s1 = Application.Text(a, "[dbnum2]")
If a = 0 Then
If b = 0 Then
If c = 0 Then
中文大写 = ""
Exit Function
Else
中文大写 = q(c) & "分"
Exit Function
End If
ElseIf c = 0 Then
中文大写 = q(b) & "角整"
Exit Function
Else
中文大写 = q(b) & "角" & q(c) & "分"
Exit Function
End If
ElseIf b = 0 Then
If c = 0 Then
中文大写 = s1 & "元整"
Exit Function
Else
中文大写 = s1 & "元零" & q(c) & "分"
Exit Function
End If
ElseIf c = 0 Then
中文大写 = s1 & "元" & q(b) & "角整"
Exit Function
Else
中文大写 = s1 & "元" & q(b) & "角" & q(c) & "分"
Exit Function
End If

End Function 参考技术A 使用Text函数即可。
如将78转换为七十八：=Text(78,"[dbnum1]")
如将78转换为柒拾捌：=Text(78,"[dbnum2]")
数字可以为单元格引用，也就是把78改为A1形式。 参考技术B 楼主说的不是很具体，下面的内容请参考：
读取单元格的值，求出长度，利用循环逐个对单元格内的数字使用SELECT CASE语句 进行替换。

EXCEL VBA转为文本

Dim rg As Range Set rg = [a39:j1308] arr = rg rg.ClearContents For i = 1 To 10 k = 0 For j = 1 To 1270 If arr(j, i) <> "" Then k = k + 1 Cells(k + 38, i) = arr(j, i) End If Next Cells(38, i) = i - 1 & "共" & k & "个" c = c + k Next [m38] = "全共" & c & "个" [a39:j1308].Copy Set sh = Sheets.Add(after:=Sheets(Sheets.Count)) sh.[a1].PasteSpecial xlPasteAll sh.Copy ActiveWorkbook.SaveAs "E:\XXX.txt", xlCSV sh.Delete WorkbooksClose False

数据范围为 [a39:j1308]
直接导出为文本，如XXX.txt，不要EXCEL格式
没有路径（与EXCEL 同位置）

参考技术A Sub s()
    pth = ThisWorkbook.Path
    Open pth & "xxxx.txt" For Output As #1
    For i = 39 To 1038
        t = Join(Application.Transpose(Application.Transpose(Cells(i, 1).Resize(1, 10))), ",")
        Print #1, t
    Next
    Close #1
End Sub

本回答被提问者和网友采纳