自动十进制插入

小数点后两位数字我做了很多工作。 我的join机器有很好的function，我可以input一串数字，如123456，它会自动插入小数点，并显示为1234.56。 Excel在高级选项下有一个function，可以自动input小数点，但是它是一个全局选项，所以没有那么有用。 因此，我为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 

当我input数据的时候，这种方式已经足够好了，但是如果我从另一个单元格复制数据，那么在小数点后面有有效数字的情况下，它会起作用。 有没有办法告诉数据是否被input到单元格中，或者是否从剪贴板中粘贴？

Answer 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即可。这比使用string操作要快得多，这就是你现在正在做的事情。

同样适用于复制和粘贴（甚至多个单元格）。

顺便说一句，你需要把这个添加到你想要发生的每张纸上。

编辑：更新代码是在工作簿级别

Answer 2

我想我必须回答自己的问题，以便我可以显示我的代码更改，但我会接受你的答案，因为大部分的关键要素在那里。 我得到这个编辑和复制/粘贴。 诀窍是要识别你什么时候粘贴。 当我粘贴这行时我发现我可以退出：

 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中称为侦听器？）。 我把这段代码放在类模块中，虽然现在还不确定是否需要这样做。 我保存该文件，然后select它作为Excel选项中的一个加载项，但我可能需要努力一点来记住我是如何做到这一点的。 然后，我只是select插件是积极的，现在，在你的帮助下，我得到了它的工作。 谢谢你，@ joseph4tw。 在我的版本中，我也有一些代码将斜线放在date中，所以您不必这样做，但是现在我需要使用这些改进来testing这些代码，以查看它是否有效。