Question

有人可以帮助我使用下面的代码我正在尝试捕获粘贴事件以获取粘贴的选择，以便删除空格和不可打印的字符。所以基本上当我粘贴时我需要它来自动检查我是否粘贴并从粘贴选择中删除任何空格和不可打印字符这将减少我的宏将处理的时间，因为在给定时间将粘贴几行并且它对于我来说，在这个状态下删除空格和不可打印字符似乎合乎逻辑，而列表很小并且不会产生太多延迟。它在我身上崩溃，无法绕过它。

一如既往，我们将非常感谢任何帮助。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim lastAction As String
  'On Error Resume Next
  ' Get the last action performed by user
  lastAction = Application.CommandBars("Standard").Controls("&Undo")
Debug.Print lastAction
  ' Check if the last action was a paste
  If Left(lastAction, 5) = "Paste" Then

   Call removeSpace
  End If

End Sub

Private Sub removeSpace()
Dim rngremovespace As Range
Dim CellChecker As Range
Dim rng As Range
'Set the range
Set rngremovespace = Selection
'Application.ScreenUpdating = False
'This check to see if there are any non printing characters and replace them
   rngremovespace.Select
rngremovespace.Columns.Replace What:=Chr(160), Replacement:=Chr(32), _
     LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False

     'In case of any error skip
On Error Resume Next
'Looping through a range that is resizing
     For Each CellChecker In rngremovespace.Columns

     'This will clear all space in the cells
    CellChecker.Value = Application.Trim(CellChecker.Value)
    CellChecker.Value = Application.WorksheetFunction.Clean(CellChecker.Value)

  'Looping to the next CellChecker
   Next CellChecker

    On Error GoTo 0
  ' Application.ScreenUpdating = True
Set rngremovespace = Nothing
End Sub

Answer 1

需要检查撤消列表是否为空，循环单元格而不是列，以及禁用事件（未测试）：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Application.CommandBars("Standard").Controls("&Undo")
        If .ListCount < 1 Then Exit Sub
        If .List(1) <> "Paste" Then Exit Sub            
    End With

    Application.CutCopyMode = False
    Application.EnableEvents = False
    Selection.Replace ChrW(160), " ", xlPart
    Dim cell As Range
    For Each cell In Selection
        cell.Value2 = WorksheetFunction.Trim(WorksheetFunction.Clean(cell.Value2))        
    Next
    Application.EnableEvents = True
End Sub

如何在VBA中捕获所有工作表的粘贴事件？

1 个答案: