如何從列中選擇符合多個條件的行？

Question

我試圖複製和粘貼列B中出現的列A到新的工作表（例如，複製和粘貼列A中包含1,2和7的所有行到新工作表）。我知道一個不太聰明的方式使用宏。我相信使用嵌套循環會使生活更輕鬆（當列B是一個長列表），但是，我沒有工作。請參閱下面的LessSmartWay代碼和FailedSmartWay代碼。

表看起來是這樣的：

A B C D 
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 

Answer 1

每次通過外環

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 

Answer 2

一對夫婦爲/每個循環遍歷一個迭代範圍，重置第j值。它似乎有點乾淨。

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