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

today0427

鲁班尺.rar (14.92 KB, 下载次数: 1)

2016-9-14 09:41 上传

点击文件名下载附件 网上有一个RMB人民币转大写的自定义函数，感觉这两个差不多，我修改了一下，额……水平不行，其实还挺难改的

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

复制代码

fjmxwrs

today0427 发表于 2016-9-14 09:41
网上有一个RMB人民币转大写的自定义函数，感觉这两个差不多，我修改了一下，额……水平不行，其实还挺难改 ...

挺好，但整数时，没有计量单位了

fjmxwrs

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

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

1. Function LBC(rng)
   
2. Dim i, i1%, T1$, T2$
   
3. If rng <> "" Then
   
4. If Int(rng) < rng Then
   
5. i = Mid(rng, InStr(rng, ".")) * 1000
   
6. T1 = Application.Text(i, "[DBNum2]0尺0寸0分")
   
7. T1 = Replace(Replace(Replace(Replace(T1, "零尺零寸零分", ""), "零尺", ""), "零寸", ""), "零分", "")
   
8. End If
   
9. i1 = Int(rng)
   
10. If i1 > 0 Then
    
11. T2 = Application.Text(i1, "[DBNum2]")
    
12. T2 = T2 & "丈"
    
13. End If
    
14. LBC = " 为鲁班尺 " & T2 & T1
    
15. Else
    
16. LBC = ""
    
17. End If
    
18. End Function
    

复制代码

today0427

挺好，但整数时，没有计量单位了

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

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

复制代码

huangxuejin

最后感谢三位老师们为我付出，在此再次深表感谢，祝中秋快乐，万事如意。