如何从列中select符合多个条件的行?

我试图复制和粘贴基于列B出现在列B到新的工作表的行(例如,复制和粘贴列A中的1,2和7的所有行到新工作表)。 我知道一个不太聪明的方式使用macros。 我相信使用嵌套循环将使生活更容易(当列B是一个长列表),但是,我没有工作。 请参阅下面的LessSmartWay代码和FailedSmartWay代码。

表格看起来像这样:

ABCD 1 1 a 1/1/2015 1 2 b 1/2/2015 1 7 c 1/3/2015 2 - a 1/4/2015 3 - b 1/5/2015 3 - c 1/6/2015 3 - a 1/7/2015 3 - b 1/8/2015 4 - c 1/9/2015 4 - a 1/10/2015 5 - b 1/11/2015 5 - c 1/12/2015 6 - a 1/13/2015 6 - b 1/14/2015 6 - c 1/15/2015 7 - a 1/16/2015 7 - b 1/17/2015 7 - c 1/18/2015 

 Sub LessSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer d = 1 j = 2 Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B2") Or t.Range("A" & j) = t.Range("B3") Or t.Range("A" & j) = t.Range("B4") Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop End Sub 

 Sub FailedSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer Dim i As Integer d = 1 j = 2 i = 2 Do Until IsEmpty(t.Range("B" & i)) Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B" & i) Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop i = i + 1 Loop End Sub 

每次迭代外循环时重置j值

 Do Until IsEmpty(t.Range("B" & i)) ' Insert this line here j = 2 Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B" & i) Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop i = i + 1 Loop 

一对For / Each循环遍历一个Range。 它似乎有点干净。

 Dim LastRowA As Long Dim LastRowB As Long Dim WB As Workbook Set WB = ActiveWorkbook Dim wks As Worksheet Dim wks2 As Worksheet Set wks = WB.Sheets("test") Set wks2 = WB.Sheets("select") LastRowA = wks.Cells(wks.Rows.Count, "A").End(xlUp).ROW LastRowB = wks.Cells(wks.Rows.Count, "B").End(xlUp).ROW Dim rowRangeA As Range Dim rowRangeB As Range Set rowRangeA = wks.Range("A1:A" & LastRowA) Set rowRangeB = wks.Range("B1:B" & LastRowB) ' keep track of our current line on second worksheet Dim currentEndingRow As Integer currentEndingRow = 1 For Each mCellA In rowRangeA 'Our nested loop, will cycle through each row in B once for every row in A. For Each mCellB In rowRangeB If mCellA.Value = mCellB.Value Then 'wks2.Cells(currentEndingRow, 1).Value = mCellA.Value wks2.Rows(currentEndingRow).Value = wks.Rows(mCellB.Row).Value currentEndingRow = currentEndingRow + 1 End If Next mCellB ' Move on to the next Row A after it finishes the last row in B. Next mCellA