Question

我有一个庞大的列表，我需要处理它可能有超过150k行的工作数据可能是这样的

alimentdsk  2   2   2
aaaa        2   2   2
aaaa        2   2   2
asd         1   1   1
fal         1   1   1
d aliment t 1   1   1

现在我需要将包含 aliment 的所有行复制到另一张表。

我一直在尝试使用此代码，但它会复制所有行

Private Sub Workbook_Open()
 Dim rngCell As Range
    Dim objMyUniqueArray As Object
    Dim lngMyArrayCounter As Long
    Dim lngMyRow As Long
    Dim varMyItem As Variant

    Application.ScreenUpdating = False

    Set objMyUniqueArray = CreateObject("Scripting.Dictionary")

    For Each rngCell In Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
        If InStr(rngCell, "aliment") > 0 Then
            If Not objMyUniqueArray.Exists(Trim(Cells(rngCell.Row, "C"))) Then
                lngMyArrayCounter = lngMyArrayCounter + 1
                objMyUniqueArray.Add (Trim(Cells(rngCell.Row, "C"))), lngMyArrayCounter
                varMyItem = Sheets("Sheet1").Cells(rngCell.Row, "C")
                For lngMyRow = 1 To Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
                    If Sheets("Sheet1").Cells(lngMyRow, "C") = varMyItem Then
                        Rows(lngMyRow).Copy Destination:=Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1)
                    End If
                Next lngMyRow
            End If
        End If
    Next rngCell

    Set objMyUniqueArray = Nothing

    Application.ScreenUpdating = False

    MsgBox "All applicable rows have been copied.", vbInformation

End Sub

任何帮助都会受到影响：）

Answer 1

使用内置过滤器。如果你只是看一栏它的超级简单。我不知道你有什么版本，但在2010年它的数据选项卡，然后过滤按钮。你会看到所有列都有一个下拉箭头。转到所需的列，单击箭头，将鼠标悬停在下拉列表中的“文本过滤器”上，然后在弹出窗口中单击“包含”。它会弹出一个小窗口，它会显示列标题，你可以从包含，开始，结束，等等中更改选项，然后输入要查找的标准。所以你的情况下你将其保留为包含，并在critera中键入“Aliment”。现在它将只显示该列中具有该值的每一行。然后你可以按ctrl + A选择所有可见行，按ctrl + C复制，（或按ctrl + X剪切）选择你的工作表，转到底部，然后粘贴到数据底部的第1列，巴姆。完成。

要制作一个宏，你可以这样做：

Sub Macro6()

   'Macro6 Macro



    Dim rng As Range

    Dim numrows As Long
    Dim numcols As Long

    numrows = Cells.find("*", [A1], , , xlByColumns, xlPrevious).column 'finds number of rows
    numrows = Cells.find("*", [A1], , , xlByColumns, xlPrevious).column ' finds number of columns

    Set rng = Range(Cells(1, 1), Cells(numrows, numColumns)) 'gets all cells

    ActiveSheet.Range("$A$1:$J$7725").AutoFilter Field:=7, Criteria1:="=*aliment*", Operator:=xlAnd 'this applies filter. *NOTE: change number after "field" to the number of the column

    Set rng = rng.SpecialCells(xlCellTypeVisible) 'after filter, this gets only visible cells (cells matching filter critera)
    rng.Copy 'copy rng

    Sheets("Sheet3").Select 'select appropriate sheet
    ActiveSheet.Paste  'paste
End Sub

这是一个粗略的草图，你可能需要对它进行调整，它会比在for循环中一行一行地快得多。

宏通配符搜索并将整行复制到sheet2

1 个答案: