# excel某单元的数据自动小写转换为大写

春节无事在老家也不能上网，节前对excel的vba突然来了兴趣，琢磨着把原来其他语言的小写转换大写函数搬到vba中，经过试验，修改成功，现贴出和大家分享。

首先说一下设定的需求，想在某个单元格输入完后，自动把当前的数字转换为大写。有此需求我就查找excel的事件，找到Worksheet_Change事件，经过试验符合我的要求，就在此事件中添加如下代码（代码并不完善，附后再说）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTmp As String

'第3列，第73行修改数值
If Target.Cells.Column = 3 And Target.Cells.Row = 73 Then
strTmp = TransMoney(Target.Cells.Value)
Target.Font.ColorIndex = 5
Target.NoteText Target.Cells.Value
Target.Cells.Value = strTmp
End If
End Sub

'人民币大小写转换函数
Function TransMoney(strOrg As String) As String
Dim strValue, strUnit1, strUnit2 As String
Dim ii, kk As Integer
Dim ipos1
Dim iFix As Boolean
Dim strFix, strDec As String
TransMoney = ""
strValue = "零壹贰叁肆伍陆柒捌玖"
strUnit1 = "元拾佰仟万拾佰仟亿拾佰仟"
strUnit2 = "角分"
fmoney = CDbl(strOrg)
If fmoney = 0 Then
TransMoney = "零元整"
End If
ipos1 = InStr(1, strOrg, ".", vbTextCompare)
If ipos1 = 0 Then
iFix = True
strFix = strOrg
strDec = ""
Else
strFix = Mid(strOrg, 1, ipos1 - 1)
strDec = Mid(strOrg, ipos1 + 1, ipos1 + 2)
'考虑.00情况
ipos1 = Len(strDec)
If CDbl(strDec) = 0 Then
iFix = True
End If
End If

ipos1 = Len(strFix)
For ii = 0 To ipos1 - 1
jj = ipos1 - ii - 1
kk = Mid(strFix, ii + 1, 1)
If kk <> "0" Then
If iHeadZero <> 0 Then '表示前面有零值，需补零
strDest = strDest + MidB(strValue, 1, 2)
End If
strDest = strDest + MidB(strValue, (kk) * 2 + 1, 2)
strDest = strDest + MidB(strUnit1, jj * 2 + 1, 2)
End If

If kk = "0" Then
'该位在“亿”或“万”上，需要补上单位
If ((jj <> 8) Or (jj <> 4) And (iHeadZero < 4)) Then
If jj > 3 Then
strDest = strDest + MidB(strUnit1, jj * 2 + 1, 2)
End If
End If
End If
Next
strDest = strDest + MidB(strUnit1, 1, 2)
End If

ipos1 = Len(strDec)
For ii = 0 To ipos1 - 1
kk = Mid(strDec, ii + 1, 1)
If kk <> "0" Then
If iHeadZero <> 0 Then '前面有零值，补零
strDest = strDest + Mid(strValue, 1, 2)
End If
strDest = strDest + MidB(strValue, (kk) * 2 + 1, 2)
strDest = strDest + MidB(strUnit2, ii * 2 + 1, 2)
End If
If kk = "0" Then
End If
Next
If iFix = True Then
strDest = strDest + "整"
End If
TransMoney = strDest
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTmp As String
If Target.Cells.Column = 3 And Target.Cells.Row = 73 Then
strTmp = TransMoney(Target.Cells.Value)
Target.Font.ColorIndex = 5

'加这个是为了对比小写是否和大写一致。没什么实际用途
Target.NoteText Target.Cells.Value
Application.EnableEvents = Fals
Target.Cells.Value = strTmp
Application.EnableEvents = True
End If
End Sub

• 1
点赞
• 0
收藏
觉得还不错? 一键收藏
• 0
评论
08-04
08-20 209
06-16 1791
03-22 2910
01-12 1万+
06-16
09-14
03-01 357
03-01 432
03-01 166

### “相关推荐”对你有帮助么？

• 非常没帮助
• 没帮助
• 一般
• 有帮助
• 非常有帮助

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。