宏通配符搜索和複製整行到Sheet2

我有一個巨大的名單，我需要進行這項工作，可能有超過15萬行進行工作的數據可能是這樣宏通配符搜索和複製整行到Sheet2

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

現在我需要的所有將包含準備的行復制到另一個工作表。

我一直在嘗試這種代碼，但它會將所有行

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

任何幫助，將apriciated :)

來源

2014-03-07 user3393324

請說清楚你到底想幹什麼？只需複製'A'列中的單元格包含'aliment'的所有行？或者你對列「C」有一些額外的要求（我從你的代碼中看到過）？如果是，他們是什麼？順便說一句，你使用的是什麼版本的Excel？ –

使用內置的過濾器。如果你只是在看一列它的超級簡單。我不知道你有什麼版本，但在2010年它的數據標籤，然後過濾按鈕。你會看到所有列上都有一個下拉箭頭。轉到您想要的列，單擊箭頭，將鼠標懸停在下拉列表中的「文本過濾器」上，然後在彈出窗口中單擊「包含」。它會彈出一個小窗口，它會顯示列標題，並且您可以更改包含的選項，開始於，結束於，無論如何......然後您輸入要查找的條件。所以你的情況你會把它作爲包含，你會在標籤中輸入「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循環。

來源

2014-03-07 19:06:03 user1759942

宏通配符搜索和複製整行到Sheet2

回答

相關問題