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

其中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第一步，希望大伙多多交流。