[已解决]求老师们帮我一个数值转大写的VBA代码 (效果见附件)

huangxuejin · 发表于 2016-9-13 17:03

求老师们帮我一个数值转大写的VBA代码 (效果见附件)

最佳答案

today0427

2016-9-14 14:41

本帖最后由 today0427 于 2016-9-14 15:24 编辑

(, 下载次数: 40)

上传
点击文件名下载附件
挺好，但整数时，没有计量单位了

谢谢大神提醒，因为没有模拟到这种数据，所以出现问题了，前面加了一个if判断就好了

Public Function lbc(M) '鲁班尺
If InStr(M, ".") = 0 Then
lbc = Application.Text(M, "[DBnum2]") & "丈"
If lbc = "零丈" Then lbc = ""
lbc = IIf(lbc = "", lbc, "为鲁班尺 " & lbc)
Exit Function
End If
lbc = Replace(Application.Text(Round(M + 0.00000001, 3), "[DBnum2]"), ".", "丈")
lbc = IIf(Left(Right(lbc, 4), 1) = "丈", Left(lbc, Len(lbc) - 2) & "尺" & Left(Right(lbc, 2), 1) _
& "寸" & Right(lbc, 1) & "分", IIf(Left(Right(lbc, 3), 1) = "丈", Left(lbc, Len(lbc) - 1) & "尺" _
& Right(lbc, 1) & "寸", IIf(Left(Right(lbc, 2), 1) = "丈", lbc & "尺", lbc)))
lbc = Replace(Replace(Replace(Replace(Replace(lbc, "零丈零尺零寸", ""), "零丈零尺", ""), "零丈", ""), "零尺", ""), "零寸", "")
lbc = "为鲁班尺 " & lbc
End Function

复制代码

Excel学徒123 · 发表于 2016-9-13 18:30

本帖最后由 Excel学徒123 于 2016-9-13 18:43 编辑

Option Explicit
Function ChangeCode(rng As Range) As String
Dim strText$, StrLeft$, strRight$, strRst$, strVal$
Dim i%, j%
Dim blComma As Boolean
Dim arrName, arrCode
arrName = Array("尺", "寸", "分")
arrCode = Array("", "十", "百", "千", "万", "十万", "百万", "千万", "亿")
blComma = (InStr(rng.Value, ".") > 0)
If blComma Then
StrLeft = Left(rng.Value, InStr(rng, ".") - 1)
strRight = Replace(rng.Value, StrLeft & ".", "")
For i = 1 To Len(strRight)
If Mid(strRight, i, 1) * 1 <> 0 Then
strText = strText & Application.WorksheetFunction.Text(Mid(strRight, i, 1), "[DBNum2]0") & arrName(i - 1)
End If
Next
If Len(StrLeft) = 0 Then
strRst = "为鲁班尺 " & strText
Else
If Len(StrLeft) > 1 Then
For j = 1 To Len(StrLeft)
strVal = strVal & Application.WorksheetFunction.Text(Mid(StrLeft, j, 1), "[DBNUM2]0") & arrCode(Len(StrLeft) - j)
Next
Else
strVal = Application.WorksheetFunction.Text(StrLeft, "[DBNum2]0")
End If
strRst = "为鲁班尺 " & strVal & "丈" & strText
End If
End If
ChangeCode = strRst
End Function

复制代码

勉强写了个自定义函数，没写完，忙着下班，自己参考下吧

fjmxwrs · 发表于 2016-9-14 14:18

本帖最后由 fjmxwrs 于 2016-9-14 14:30 编辑

huangxuejin 发表于 2016-9-13 21:25
现在可以了，好使，再次表示感谢，

空值为空，非数值为错误值，修改简化如下

Function LBC(rng)
Dim i, i1%, T1$, T2$
If rng <> "" Then
If Int(rng) < rng Then
i = Mid(rng, InStr(rng, ".")) * 1000
T1 = Application.Text(i, "[DBNum2]0尺0寸0分")
T1 = Replace(Replace(Replace(Replace(T1, "零尺零寸零分", ""), "零尺", ""), "零寸", ""), "零分", "")
End If
i1 = Int(rng)
If i1 > 0 Then
T2 = Application.Text(i1, "[DBNum2]")
T2 = T2 & "丈"
End If
LBC = " 为鲁班尺 " & T2 & T1
Else
LBC = ""
End If
End Function

复制代码

fjmxwrs · 发表于 2016-9-13 19:01

复制代码

huangxuejin · 发表于 2016-9-13 20:58

Excel学徒123 发表于 2016-9-13 18:30
勉强写了个自定义函数，没写完，忙着下班，自己参考下吧

好使，在此衷心的感谢您，在百忙之中帮了我，谢谢谢谢......

Excel学徒123 · 发表于 2016-9-13 21:05

huangxuejin 发表于 2016-9-13 20:58
好使，在此衷心的感谢您，在百忙之中帮了我，谢谢谢谢......

不谢，代码还需要修改，有时间再搞，现在晕得厉害，解决之后不介意给个最佳就OK

huangxuejin · 发表于 2016-9-13 21:05

fjmxwrs 发表于 2016-9-13 19:01

感谢您百忙之中抽出时间帮我编写了代码，再次麻烦你帮我看一下第二行的代码运行时显示红色，（Dim i%, iT1$$$$）什么问题帮我看看。

Excel学徒123 · 发表于 2016-9-13 21:15

huangxuejin 发表于 2016-9-13 21:05
感谢您百忙之中抽出时间帮我编写了代码，再次麻烦你帮我看一下第二行的代码运行时显示红色，（Dim i%, i ...

多了几个美元符号，保留1个就可以了

huangxuejin · 发表于 2016-9-13 21:25

Excel学徒123 发表于 2016-9-13 21:15
多了几个美元符号，保留1个就可以了

现在可以了，好使，再次表示感谢，

fjmxwrs · 发表于 2016-9-13 22:42

huangxuejin 发表于 2016-9-13 21:05
感谢您百忙之中抽出时间帮我编写了代码，再次麻烦你帮我看一下第二行的代码运行时显示红色，（Dim i%, i ...

复制代码

几种可能的情况都写了，请看附件

fjmxwrs · 发表于 2016-9-13 22:44

huangxuejin 发表于 2016-9-13 21:05
感谢您百忙之中抽出时间帮我编写了代码，再次麻烦你帮我看一下第二行的代码运行时显示红色，（Dim i%, i ...

那个美元符号是上传代码时自动添加的，保留一个即可，那是定义变量类型为文本型的

		自动登录	找回密码
密码			注册