自動十進制插入

Question

我用小數點後兩位數字做了很多工作。我的添加機具有很好的功能，我可以輸入一串數字，如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 

此作品不夠好，當我輸入數據，但如果我從另一個單元格複製數據，它的工作原理，如果有小數點後顯著數字，但如果它不是零。有沒有辦法判斷數據是否被輸入到單元格中，或者是否從剪貼板粘貼了數據？

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即可。這應該比使用字符串操作更快，這就是您現在正在做的事情。

適用於複製和粘貼（甚至多個單元格）。

順便說一下，您需要將其添加到每個希望發生這種情況的工作表。

編輯：更新的代碼是在工作簿級別

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 

這是一個事件處理程序（它被稱爲Excel中的一個監聽器？）的App_SheetChange事件。我把這段代碼放在類模塊中，儘管我現在還不確定它是否需要這樣做。我保存了該文件，然後選擇它作爲Excel選項中的加載項，但我可能需要努力一點來記住我是如何做到這一點的。然後，我選擇了插件，並且現在，在您的幫助下，我開始工作。謝謝你，@ joseph4tw。在我的版本中，我還有一些代碼可以將斜槓放在日期中，因此您不必這樣做，但是現在需要通過這些改進來測試代碼，以確定它是否有效。