複製行時改進循環速度

我使用以下For循環根據列中存在的條件將行從一個表複製到另一個表。我開始了一個新項目，我需要複製數以萬計的行，而且性能沒有我想要的那麼快。我想知道是否有更高效的方法來完成這個相同的任務。我很感激任何建議。複製行時改進循環速度

Sub CopyThings() 

    Dim Source As Worksheet 
    Dim Target As Worksheet 
    Dim c As Range 
    Dim CriteriaRange As Range 
    Dim CriteriaString As String 
    Dim LastRow As Long 
    Dim j As Integer 
    Set Source = Worksheets("source data") 
    Set Target = Worksheets("target sheet") 
    LastRow = Source.Cells(Rows.Count, 1).End(xlUp).Row 

    With Source 
     Set CriteriaRange = Source.Range(.Cells(2, 5), .Cells(LastRow, 5)) 
    End With 

    j = 2 
     For Each c In CriteriaRange 
      CriteriaString = c.Text 
       Select Case CriteriaString 
        Case Is = "thing to copy" 
         Source.Rows(c.Row).Copy Target.Rows(j) 
    j = j + 1 
       End Select 
      Next c 

    Source.Rows(1).Copy Target.Rows(1) 

End Sub

來源

2017-07-17 peter.domanico

你是通過循環每一個細胞都在尋找「東西複製」，然後複製整個行。是否僅存在於每行中的一列中的「要複製的東西」？如果是這樣，你可以循環遍歷你的'CriteriaRange'中的每個行，並檢查可能存在的文本列，然後複製。這比檢查範圍內的每個細胞要快得多。 – JNevill

@JNevill字符串「要複製的東西」只存在於每行的單個列中。「CriteriaRange」是此列的使用範圍。如果我沒有弄錯，這個腳本已經完成了你所描述的內容。 –

可能是一些簡單的東西，例如'if c =「thing to copy'then c.row.copy target.cells（target.rows.count，」A「）。end（xlup）.offset（1）' – Davesexcel

你可以嘗試在一個複製操作複製所有匹配的行：

Sub CopyThings() 
    With Worksheets("source data").UsedRange 
     .AutoFilter 
     .AutoFilter Field:=5, Criteria1:="=thing to copy" 
     .Copy Worksheets("target sheet").Range("A1") 
    End With 
End Sub

來源

2017-07-17 21:58:23 YowE3K

這樣做，謝謝！ –

複製行時改進循環速度

回答

相關問題