Question

我尝试将基于列B中出现的行的行复制并粘贴到新工作表中（例如，将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

每次遍历外循环时重置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

Answer 2

一对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

如何从列中选择满足多个条件的行？

2 个答案: