简化我的代码〜350,000行查找。

Question

我有一个约350,000行数据的列表，我需要排序并将结果粘贴到新的WS上。前12列是权重，第12列是定性值。我需要在值为2530的前12行中搜索权重，同时也具有相应的定性值0.

权重从C列开始，并且在O列中具有对应的定性值（+12列）。对于所有12列权重和随后的定性值重复该模式。

我是VBA的新手，我的代码已经从各种来源拼凑在一起。这似乎需要永远运行，我不确定是否它是错误的代码或只是一个庞大的数据集为Excel处理。任何帮助是极大的赞赏。谢谢！

Sub CopyRowsWithNumbersInB() 
Dim X As Long 
Dim LastRow As Long 
Dim Source As Worksheet 
Dim Destination As Worksheet 
Dim RowsWithNumbers As Range 
Set Source = Worksheets("Sheet1") 
Set Destination = Worksheets("Sheet2") 

With Source 
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 
For X = 1 To LastRow 
If _ 
    (IsNumeric(.Cells(X, "C").Value) And .Cells(X, "C").Value < "2530" And IsNumeric(.Cells(X, "O").Value) And .Cells(X, "O").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "D").Value) And .Cells(X, "D").Value < "2530" And IsNumeric(.Cells(X, "P").Value) And .Cells(X, "P").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "E").Value) And .Cells(X, "E").Value < "2530" And IsNumeric(.Cells(X, "Q").Value) And .Cells(X, "Q").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "F").Value) And .Cells(X, "F").Value < "2530" And IsNumeric(.Cells(X, "R").Value) And .Cells(X, "R").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "G").Value) And .Cells(X, "G").Value < "2530" And IsNumeric(.Cells(X, "S").Value) And .Cells(X, "S").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "H").Value) And .Cells(X, "H").Value < "2530" And IsNumeric(.Cells(X, "T").Value) And .Cells(X, "T").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "I").Value) And .Cells(X, "I").Value < "2530" And IsNumeric(.Cells(X, "U").Value) And .Cells(X, "U").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "J").Value) And .Cells(X, "J").Value < "2530" And IsNumeric(.Cells(X, "V").Value) And .Cells(X, "V").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "K").Value) And .Cells(X, "K").Value < "2530" And IsNumeric(.Cells(X, "W").Value) And .Cells(X, "W").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "L").Value) And .Cells(X, "L").Value < "2530" And IsNumeric(.Cells(X, "X").Value) And .Cells(X, "X").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "M").Value) And .Cells(X, "M").Value < "2530" And IsNumeric(.Cells(X, "Y").Value) And .Cells(X, "Y").Value > "0") Or (_ 
    IsNumeric(.Cells(X, "N").Value) And .Cells(X, "N").Value < "2530" And IsNumeric(.Cells(X, "Z").Value) And .Cells(X, "Z").Value > "0") Then 

    If RowsWithNumbers Is Nothing Then 
     Set RowsWithNumbers = .Cells(X, "C") 
     Else 
     Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "C")) 
    End If 
End If 
Next 
If Not RowsWithNumbers Is Nothing Then 
    RowsWithNumbers.EntireRow.Copy Destination.Range("A1") 
End If 
End With 
End Sub 

Answer 1

可能是下面就带你到一些实惠速度：

Option Explicit 

Sub main() 
    Dim iColumn As Long 
    Dim RowsWithNumbers As Range 

    Application.ScreenUpdating = False 
    iColumn = 1 
    With ThisWorkbook.Worksheets("SheetData") '<--| reference your sheet name 
     With .Range("Z1", .cells(.Rows.Count, "C").End(xlUp)) '<--| reference its column C:Z range from row 1 (header) down to the last column C not empty row 
      Set RowsWithNumbers = .Offset(, .Columns.Count).Resize(1, 1) '<--| add a "dummy" cell to avoid 'If Not RowsWithNumbers Is Nothing' check (the "dummy" cell will be eventually removed) 
      Do 
       .AutoFilter Field:=iColumn, Criteria1:="<2530" '<--| filter 'iColumn' column with numbers < 2530 
       .AutoFilter Field:=iColumn + 12, Criteria1:=">0" '<--| filter 'iColumn+12' column with numbers >0 
       If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then Set RowsWithNumbers = Union(RowsWithNumbers, .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)) 
       iColumn = iColumn + 1 
      Loop While iColumn <= 12 
     End With 
     .AutoFilterMode = False '<--| remove autofilter 
     Set RowsWithNumbers = Intersect(RowsWithNumbers, .cells) '<--| remove "dummy" cell 
     If Not RowsWithNumbers Is Nothing Then Intersect(RowsWithNumbers.EntireRow, .cells).Copy Worksheets("Destination").Range("A1") 
    End With 
    Application.ScreenUpdating = True 
End Sub