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第一步,希望大伙多多交流。
首先说一下设定的需求,想在某个单元格输入完后,自动把当前的数字转换为大写。有此需求我就查找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第一步,希望大伙多多交流。
相关文章推荐
- winform中将数据以文本的格式导出到excel中(以文本导出表示如果数据为0001则在excel中也显示为0001,而不被excel自动转换为1)
- 在excel中人民币小写金额自动转大写金额
- ThinkPHP查询数据的时候,自动把字段名的大写切换成小写的问题!
- android Editext限制输入数字和字母以及将小写自动转换成大写的方法
- 输入一个字符若是大写自动转换成小写(使用条件运算符来)
- Excel小写字母自动转换为大写字母
- 巧妙转换 让Excel人民币小写变大写
- 转:将Excel中的坐标数据转换为DAT数据文件,并在自动成图软件中展点
- VB 录入字母大写自动转换成小写及小写自动转换成大写
- RFC里,系统会自动将小写转化为大写,提取不到数据的解决办法
- 在EXCEL中金额小写转换为大写
- Excel数字小写金额转换汉字大写金额公式的简单设置
- EXCEL将一列英文转换成大写或小写
- 规范输入 :将输入的数据中的开头,结束的空字符去掉,并将大写字符转换成小写
- 将输入的数据中的开头,结束的空字符去掉,并将大写字符转换成小写
- js将金额小写自动转换成大写
- 真正正确的人民币 小写 大写 转换算法
- 使用ASP.NET AJAX异步调用Web Service和页面中的类方法(5):服务器端和客户端数据类型的自动转换:基本类型和枚举类型
- 用PHP 把小写金额转换成大写金额,两位小数(精确角分)
- 将用户输入的小写货币形式转换为规范的大写货币形式