自动十进制插入

时间:2013-10-22 16:54:43

标签: excel

我在小数点后有两个位置的数字做了很多工作。我的添加机器有一个很好的功能,我可以输入一串数字,如123456,它会自动为我插入小数,并显示为1234.56。 Excel在“高级选项”下有一项功能,可自动输入小数,但它是一个全局选项,因此没有它可能有用。因此,我为 App_SheetChange 事件处理程序设置了一些VBA代码,该处理程序仅对格式化为显示带有两位小数的数字的单元格执行此操作。这样,我不会得到小数,我不想要它们。代码非常简单。它看起来像这样:

  If InStr(sFormat, "0.00") > 0 Then
    If InStr(".", Source.Formula) = 0 Then
      If IsNumeric(Source.Formula) Then
        s = "00" & Source.Formula
        s = Left(s, Len(s) - 2) & "." & Right(s, 2)
        App.EnableEvents = False
        Source.Formula = CDbl(s)
        App.EnableEvents = True
      End If
    End If
  End If

这在我输入数据时运行良好,但是如果我从另一个单元格复制数据,如果小数点后面有有效数字,则可以正常工作,但如果它是零,则无效。有没有办法判断是否正在将数据输入单元格或者是否从剪贴板粘贴数据?

2 个答案:

答案 0 :(得分:1)

这个怎么样?

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim r As Excel.Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each r In Target
        If (IsNumeric(r.Value)) Then
            If (CDbl(r.Value) = Round(CDbl(r.Value))) Then
                r.Value = r.Value / 100
            End If
        End If
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

检查单元格是否为数字,如果是,则检查它是否为整数。如果它是,那么通过除以100使它成为一个分数。这应该比使用字符串操作快得多,这就是你现在正在做的事情。

也适用于复制和粘贴(甚至多个单元格)。

顺便说一句,你需要将它添加到你想要的每张纸上。

编辑:将代码更新为工作簿级别

答案 1 :(得分:1)

我想我必须回答我自己的问题,以便我可以显示我的代码更改,但我会接受你的答案,因为大多数关键元素都在那里。我把它用于编辑和复制/粘贴。诀窍在于识别你何时粘贴。我发现当我用这条线粘贴时我可以退出:

If Application.CutCopyMode <> 0 Then Exit Sub

以下是代码:

Private Sub App_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim s As String
Dim sFormat As String
Dim iPos As Integer
Dim sDate As String
Dim r As Excel.Range
  On Error GoTo ErrHandler:
  If InStr(Source.Formula, "=") > 0 Then Exit Sub
  If Application.CutCopyMode <> 0 Then Exit Sub
  sFormat = Source.NumberFormat
  iPos = InStr(sFormat, ";")
  If iPos > 0 Then sFormat = Left(sFormat, iPos - 1)
  If InStr(sFormat, "0.00") > 0 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each r In Source
        If (IsNumeric(r.Value)) And (InStr(r.Formula, ".") = 0) Then
            If (CDbl(r.Value) = Round(CDbl(r.Value))) Then
                r.Value = r.Value / 100
            End If
        End If
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End If
ErrHandler:
    App.EnableEvents = True
End Sub

这是App_SheetChange事件的事件处理程序(在Excel中称为侦听器吗?)。我把这段代码放在一个类模块中,虽然我现在还不确定它是否需要这样做。我保存了该文件,然后选择它作为Excel选项中的加载项,但我可能需要对它进行一些工作以记住我是如何做到的。然后我就选择了加载项才能激活,现在,在你的帮助下,我得到了它的工作。谢谢,@ joseph4tw。在我的版本中,我还有一些代码可以将斜杠放在日期中,所以你不必这样做,但我现在需要使用这些改进来测试代码,看它是否有效。