複数の列条件に基づいたVBAコピー行

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

あなたは、次のヘルパーサブ

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 

でAutoFilter()を使用して、フィルタを適用する列のリストとしてフィルタリングする値の対応するリストを渡し、あなたの「メイン」サブからそれを呼び出すことができます

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"