Question

我有两张受保护的床单：

客户库存
收集的股票

客户收集库存后，我会触发客户库存表中的列（G：CustomerRow），并自动剪切并粘贴到收集的库存表中的第一行（“2：2”）上方。

问题是VBA代码需要很长时间才能完成。

有人说我的代码必须进行编辑，以避免太多的东西。选择等等。

有人可以帮我修改我的代码以加快剪切粘贴宏吗？我只需要一个用于删除一行并将其值粘贴到行上方另一张（“2：2”）的宏

在客户股票表中，代码为：

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = Columns(7).Column Then 'where G is the seventh column
If Target.Value <> "" Then
Call CustomerCollected
End If
End If
End Sub

在模块中：

Sub CustomerCollected()

Dim actCell
actCell = Range("G" & ActiveCell.Row)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Response = MsgBox("Do you want to transfer this Customer from Customer Stock to      Collected Stock?", vbYesNo)
If Response <> 6 Then
Exit Sub
End If
If Response = 6 Then
Worksheets("Collected Stock").Unprotect Password:="a27826" ' change the password to    whatever you wish
If actCell <= Date Then
Rows(ActiveCell.Row).Select
Selection.Cut
Sheets("Collected Stock").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
Sheets("Customer Stock").Select
Selection.EntireRow.Delete
Range("A1").Select
End If
Worksheets("Collected Stock").Protect Password:="a27826", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=False, _
AllowFiltering:=False, _
AllowUsingPivotTables:=False
End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True


End Sub

Answer 1

您几乎不需要使用。选择任何内容 - 您可以直接访问对象属性而无需先选择它。即：

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column = 7 And Target.Value <> "" Then
    Application.EnableEvents = False '// Prevent infinite loop
      CustomerCollected
    Application.EnableEvents = True '// Re-enable events
   End If
End Sub

和

Sub CustomerCollected()

'// Check user wants to transfer row, if no then exit
If MsgBox("Do you want to transfer this Customer from Customer Stock to Collected Stock?", vbYesNo) = vbNo Then Exit Sub

'// Cut active row and insert into other workbook
ActiveCell.EntireRow.Cut
With Sheets("Collected Stock")
    .Unprotect "a27826"
    .Rows(2).EntireRow.Insert Shift:=xlDown
    .Protect "a27826"
End With
ActiveCell.EntireRow.Delete Shift:=xlUp

Application.CutCopyMode = False

End Sub

用于剪切和粘贴的vba太慢了

1 个答案: