Question

有两页房间号。

更新“完成时间表”第2列（又名B）中的数字并将其排序后，我希望例程转到工作表“工作页”，找到匹配的房间号并从第4列复制完成数据-10（又名DJ）插入“完成时间表”的第4-10列。

这行得通，但效率不高，非常慢。我知道有一种更好的方法来运行该循环，但它使我难以理解。有建议吗？

Sub Refresh_Numbers()
    Application.ScreenUpdating = False
    Dim var As Variant, iRow As Long, iRowL As Long, bln As Boolean

   'Routine to copy finishes back from Work Page to main Finish Schedule
    Worksheets("Finish Schedule").Activate
    'Set up the count as the number of filled rows in the first column of Finish Schedule
    iRowL = Cells(Rows.Count, "B").End(xlUp).Row

    'Cycle through all the cells in that column:
    For iRow = 3 To iRowL
        'For every cell in Finish Schedule, Room Number column that is not empty, search through the
        'second column in sheet Work Page for a value that matches that cell value.
        If Not IsEmpty(Cells(iRow, "B")) Then
            bln = False
            var = Application.Match(Cells(iRow, "B").Value, Sheets("Work Page").Columns(2), 0)

        'If you find a matching value, indicate success by setting bln to true and exit the loop;
        'otherwise, continue searching until you reach the end of the Sheet.
        If Not IsError(var) Then
            bln = True
        End If

        'If you do find a matching value, copy the finishes to Finish Schedule
        'If you do not find a matching value copy a blank line of cells to Finish Schedule
        If bln = False Then
            Sheets("Work Page").Range("D205:J205").Copy
            Sheets("Finish Schedule").Cells(iRow, 4).PasteSpecial Paste:=xlPasteValues
            Else
            Sheets("Work Page").Cells((iRow) - 2, 4).Copy
            Sheets("Finish Schedule").Cells(iRow, 4).PasteSpecial Paste:=xlPasteValues
            Sheets("Work Page").Cells((iRow) - 2, 5).Copy
            Sheets("Finish Schedule").Cells(iRow, 5).PasteSpecial Paste:=xlPasteValues
            Sheets("Work Page").Cells((iRow) - 2, 6).Copy
            Sheets("Finish Schedule").Cells(iRow, 6).PasteSpecial Paste:=xlPasteValues
            Sheets("Work Page").Cells((iRow) - 2, 7).Copy
            Sheets("Finish Schedule").Cells(iRow, 7).PasteSpecial Paste:=xlPasteValues
            Sheets("Work Page").Cells((iRow) - 2, 8).Copy
            Sheets("Finish Schedule").Cells(iRow, 8).PasteSpecial Paste:=xlPasteValues
            Sheets("Work Page").Cells((iRow) - 2, 9).Copy
            Sheets("Finish Schedule").Cells(iRow, 9).PasteSpecial Paste:=xlPasteValues
            Sheets("Work Page").Cells((iRow) - 2, 10).Copy
            Sheets("Finish Schedule").Cells(iRow, 10).PasteSpecial Paste:=xlPasteValues
        End If
        End If
    Next iRow
    Application.CutCopyMode = False
    Worksheets("Finish Schedule").Range("D3").Select
    Application.ScreenUpdating = True
    MsgBox "Process Completed"
End Sub

Answer 1

代码中最大的问题之一是使用.Activate，.Copy和.Paste。此外，您要一次复制一行中的每个单元格，而不是整行，并在此过程中在工作表之间来回切换

未经测试 ：备份工作簿

Sub Refresh_Numbers()

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Dim wsFinish As Worksheet, wsWork As Worksheet
    With ThisWorkbook
        Set wsFinish = .Worksheets("Finish Schedule")
        Set wsWork = .Worksheets("Work Page")
    End With

    Dim iRow As Long
    With wsFinish
        For iRow = 3 To lastRow(wsFinish, "B")
            If Not wsWork.Range("B:B").Find(.Cells(iRow, "B"), LookIn:=xlValues, _
                        LookAt:=xlWhole) Is Nothing And Not IsEmpty(.Cells(iRow, "B")) Then

                .Range(.Cells(iRow - 2, 4), .Cells(iRow - 2, 10)).Value = wsWork.Range( _
                        wsWork.Cells(iRow, 4), wsWork.Cells(iRow, 10)).Value

            End If
        Next iRow
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Function lastRow(ws As Worksheet, Optional col As Variant = 1) As Long
    With ws
        lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
End Function

通过将工作表首先写入一个数组，将数据值传输到另一个数组，然后将新数组重写到第二个工作表，这可能会更加高效。

如何加快此过程？

1 个答案: