Question

你们有没有人可以提供加速这段代码的帮助？我假设可以使用数组，但我使用它们很糟糕。还有另外一种方法吗？非常感谢！

Application.ScreenUpdating = False

'IF using Indexed Values


    If Sheets("interface").Range("C24") = "Y" Then

    Dim x As Integer
    Dim i As Long

    For x = 15 To 51

        LastRow = Sheets("db_main").Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To LastRow

            If Sheets("db_main").Range("S" & i) = True And Sheets("db_main").Range("C" & i) = Sheets("interface").Range("F" & x) Then

                Sheets("db_main").Range("C" & i).Copy
                Sheets("intersource").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues

                Sheets("db_main").Range("A" & i).Copy
                Sheets("intersource").Range("B" & Rows.Count).End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues

                Sheets("db_main").Range("H" & i).Copy
                Sheets("intersource").Range("C" & Rows.Count).End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues

                Sheets("db_main").Range("D" & i).Copy
                Sheets("intersource").Range("D" & Rows.Count).End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues

                Sheets("db_main").Range("M" & i).Copy
                Sheets("intersource").Range("E" & Rows.Count).End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues

                Sheets("db_main").Range("O" & i).Copy
                Sheets("intersource").Range("F" & Rows.Count).End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues

            End If
               Next i

      Next x

                End If

Answer 1

如果您想避免使用数组，可以尝试取消复制/粘贴，而只是分配值（这应该可以提高性能）。试试这个：

'IF using Indexed Values
Application.ScreenUpdating = False

If Sheets("interface").Range("C24") = "Y" Then

Dim x As Long, i As Long, LastRow As Long, _
    LastSourceRow As Long, Counter As Long
Dim DBSheet As Worksheet, SourceSheet As Worksheet, _
    InterSheet As Worksheet

'identify worksheets for easier reference
Set DBSheet = ThisWorkbook.Worksheets("db_main")
Set SourceSheet = ThisWorkbook.Worksheets("intersource")
Set InterSheet = ThisWorkbook.Worksheets("interface")

For x = 15 To 51

'identify last rows
LastRow = DBSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastSourceRow = SourceSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Counter = 1

    For i = 2 To LastRow

        If DBSheet.Range("S" & i) = True And DBSheet.Range("C" & i) = InterSheet.Range("F" & x) Then

            'write DB column C to Source column A
            SourceSheet.Cells(LastSourceRow + Counter, 1) = _
                DBSheet.Cells(i, 3).Value

            'write DB column A to Source column B
            SourceSheet.Cells(LastSourceRow + Counter, 2) = _
                DBSheet.Cells(i, 1).Value

            'write DB column H to Source column C
            SourceSheet.Cells(LastSourceRow + Counter, 3) = _
                DBSheet.Cells(i, 8).Value

            'write DB column D to source column D
            SourceSheet.Cells(LastSourceRow + Counter, 4) = _
                DBSheet.Cells(i, 4).Value

            'write DB column M to Source column E
            SourceSheet.Cells(LastSourceRow + Counter, 5) = _
                DBSheet.Cells(i, 13).Value

            'write DB column O to Source column F
            SourceSheet.Cells(LastSourceRow + Counter, 6) = _
                DBSheet.Cells(i, 15).Value

            'increment counter
            Counter = Counter + 1

        End If

    Next i

Next x

End If
Application.ScreenUpdating = True

如何加快这个循环代码？

1 个答案: