Question

我正在尝试基于多个条件对行搜索进行编码，然后将复制符合条件的行。示例如下。

1         2   3
B         C   D
B         D   C
C         B   D
C         D   B
D         B   C
D         C   B

我编写的代码将根据第一列中的条件生效。我需要的是能够工作的代码，无论哪一列或多列具有标准值。（例如，如果第1列的标准是B，3则是C，它只会复制行BDC，或者如果第3列的标准是D，则会复制BCD和CBD）我当前的编写代码缺少此标准，但我会复制下方。

Private Sub listgen()
    Sheets("Segments").Activate
    Dim a As Long
    Dim b As Long
    Dim c As Long 'columns
    Dim d As Long
    Dim e As Long
    Dim r As Long 'rows
    Dim tr As Long 'total rows

    r = 3
    a = 1
    c = 3
    tr = Sheets("Trips").Cells(Rows.Count, a).End(xlUp).Row
    e = c + a

    Do
    d = a
    b = 8
        If Sheets("Trips").Cells(r, d).Value = Range("E2") Then
        Do
            Sheets("Trips").Cells(r, d).Copy Destination:=Sheets("Segments").Cells(r, b)
            d = d + 1
            b = b + 1
            Loop Until d = e
        End If
    r = r + 1
    Loop Until r = tr

End Sub

Answer 1

您可以在以下助手子

中使用AutoFilter()

Private Sub listgen(criteriaCols As Variant, criteriaVals As Variant)
    Dim iCriterium As Long

    With Worksheets("Trips") '<--| reference your "data" worksheet
        With .Range("C1", .Cells(.Rows.Count, 1).End(xlUp)) '<--| reference its columns A:C cells from row 1 down to column A last not empty row
            For iCriterium = 0 To UBound(criteriaCols) '<--| loop through filter list
                .AutoFilter field:=criteriaCols(iCriterium), Criteria1:=criteriaVals(iCriterium) '<--| filter on current filter column with current filter value
            Next
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Worksheets("Segments").Cells(.Rows.Count, 8).End(xlUp).Offset(1) '<--| if any cells filtered other than headers (row 1) then past them to "target" sheet from its column H first empty cell after last not empty one
        End With
        .AutoFilterMode = False
    End With
End Sub

并从您的＆＃34; main＆＃34; sub传递你要过滤的列列表和要过滤的相应值列表，如下所示

listgen Array(1, 3), Array("B", "C")  '<--| filter on columns 1 and 3 with, correspondingly, values "B" and "C"
listgen Array(3), Array("D")  '<--| filter on column 3 with values "D"

VBA复制行基于多个列标准

1 个答案: