Question

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

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

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

C:\Program Files (x86)\Jaspersoft\iReport-2.0.1

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

简化我的代码~35万行查找。

1 个答案: