您的位置:首页 > 其它

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

2009-02-01 15:13 302 查看
春节无事在老家也不能上网,节前对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

其中transmoney是自定义函数,小写转换为大写函数.代码如下:

'人民币大小写转换函数
Function TransMoney(strOrg As String) As String
Dim strValue, strUnit1, strUnit2 As String
Dim iHeadZero, fmoney As Currency
Dim ii, kk As Integer
Dim ipos1
Dim iFix As Boolean
Dim strFix, strDec As String
TransMoney = ""
strValue = "零壹贰叁肆伍陆柒捌玖"
strUnit1 = "元拾佰仟万拾佰仟亿拾佰仟"
strUnit2 = "角分"
iHeadZero = 0
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)
iHeadZero = 0
End If
strDest = strDest + MidB(strValue, (kk) * 2 + 1, 2)
strDest = strDest + MidB(strUnit1, jj * 2 + 1, 2)
End If

If kk = "0" Then
iHeadZero = iHeadZero + 1
'该位在“亿”或“万”上,需要补上单位
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
If iHeadZero <> 0 Then
strDest = strDest + MidB(strUnit1, 1, 2)
iHeadZero = 0
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)
iHeadZero = 0
End If
strDest = strDest + MidB(strValue, (kk) * 2 + 1, 2)
strDest = strDest + MidB(strUnit2, ii * 2 + 1, 2)
End If
If kk = "0" Then
iHeadZero = iHeadZero + 1
End If
Next
If iFix = True Then
strDest = strDest + "整"
End If
TransMoney = strDest
End Function

好似在单元格中修改数据可以自动变为大写了。但是又引发了一个问题,这个数据变为大写之后又触发 了change事件,调用大写转换函数报错,在这里我想了很多方法了屏蔽此事件比如增加了Target.Font.ColorIndex = 5等等,然后在事件中校验是否colorindex=5等等诸如此类的。直到偶尔的看到application的属性Application.EnableEvents ,才找到最终解决办法完整的change事件的代码如下

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

至此,这个小小的功能算是迈出了我的vba第一步,希望大伙多多交流。
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐