Question

此代码从数据输入表单中获取8个单元格，并将这些单元格复制到另一个用作数据库的工作表上的下一个空行。这需要15秒。如果代码没有复制到另一张表格，它可以加快代码。

有没有办法在不合并这两张纸的情况下显着加快这段代码？

sub UpdateLogWorksheet1()
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myclear As String
Dim myCell As Range
ActiveSheet.Unprotect "sallygary"

myCopy = "e4,g26,g16,g12,g18,g20,g22,g24"
Set inputWks = Worksheets("Dept 1 Input")
Set historyWks = Worksheets("1_Data")

With historyWks
    nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With

With inputWks
    Set myRng = .Range(myCopy)

End With

With historyWks
    With .Cells(nextRow, "A")
        .Value = Now()
        .NumberFormat = "mm/dd/yyyy"
    End With
    .Cells(nextRow, "B").Value = Application.UserName
    oCol = 3
    For Each myCell In myRng.Cells
        historyWks.Cells(nextRow, oCol).Value = myCell.Value
        oCol = oCol + 1
    Next myCell
End With

With inputWks
  On Error Resume Next
     End With
  On Error GoTo 0
ActiveSheet.Protect "sallygary"
Range("g12").Select
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Answer 1

不要逐个细胞复制。通过一个操作复制整个表。例如，复制100×3表

Sheet2.Range("A2").Resize(100,3).Value2 = Sheet1.Range("G2").Resize(100,3).Value2

加快复制价值

1 个答案: