Excel VBA - 尝试返回仅包含所有条件的值

Question

好吧，这个很难解释 - 我有一个非常大的表格，它有客户，零件号码，价格和收入。我需要退回所有使用零件号列表的客户;例如，如果他们使用ABC和DEF部分，那么它会返回使用这些部分的客户，以及这些客户的收入（我想我会将整行复制到另一个表或其他东西）。

我不想看到使用一个部件但不使用其他部件的客户。我试过做自动过滤器和高级过滤器，但没有运气，但如果可能的话，我宁愿在VBA中执行此操作。我不知道哪一种方式是最简单的...

一个想法是摆动表和按客户排序，但这是非常手动的，我需要将这些结果拉到另一个表，所以我可以看到数据分开。任何帮助深表感谢！

编辑：实施例表

Example Table

Answer 1

编辑 OP的澄清后。请参阅附加代码

您可以使用“Range”对象的“AutoFilter（）”方法的“xlFilterValues”运算符。

假设第一行标题，这里的“基本概念”的代码，你问：

Dim partListArr As Variant 

With Worksheets("MyListSheetName") 
    partListArr = Application.Transpose(.Range("A1", .Cells(.Rows.Count,1).End(xlUp)).Value)'<--| retrieve the content of its column A cells from row 1 down to its last not empty cell 
End With 

With Worksheets("MyDataSheetName") 
    With .Range("Z1", .Cells(.Rows.Count,1).End(xlUp)) '<--| reference its A to Z columns cells from row 1 down to column A last not empty cell 
     .Autofilter field:=2, Criteria1:=partListArray, operator:=xlFilterValues '<--| filter referenced range on its 2nd field with list of parts 
     With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--| reference filtered cells, skipping headers 

      ' here your code to handle filtered cells 

     End With 
    End With 
End With 

---

既然你澄清，你仍然可以使用嵌套AutoFilter() s到赶上合适的客户分享所有列出的部分，但将此工作留给词典更有效，并使用AutoFilter()作为最终的复制/粘贴部分。如下所示：

Option Explicit 

Sub main() 
    Dim custDict As Scripting.Dictionary, partDict As Scripting.Dictionary 
    Dim cust As Variant, part As Variant 
    Dim parts As String 
    Dim okCust As Boolean 

    With Worksheets("MyListSheetName") 
     Set partDict = GetList(.Range("A1", .Cells(.Rows.count, 1).End(xlUp))) 
    End With 

    With Worksheets("MyDataSheetName") 
     With .Range("Z1", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its A to Z columns cells from row 1 down to column A last not empty cell 
      Set custDict = GetList(.Resize(.Rows.count, 1).Offset(1)) 

      For Each cust In custDict.Keys 
       parts = custDict(cust) & "|" 
       For Each part In partDict.Keys 
        okCust = InStr(parts, "|" & part & "|") > 0 
        If Not okCust Then Exit For 
       Next part 
       If okCust Then 
        .AutoFilter field:=1, Criteria1:=cust 
        With .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--| reference filtered cells, skipping headers 
         .Copy Destination:=GetSheet(CStr(cust)).Range("A1") 
        End With 
       End If 
      Next cust 

     End With 
     .AutoFilterMode = False 
     .Activate 
    End With 
End Sub 

Function GetList(rng As Range) As Scripting.Dictionary 
    Dim dict As New Scripting.Dictionary 
    Dim cell As Range 

    For Each cell In rng.Cells 
     dict(cell.Value) = dict(cell.Value) & "|" & cell.Offset(, 1) 
    Next cell 

    Set GetList = dict 
End Function 

Function GetSheet(shtName As String) As Worksheet 
    On Error Resume Next 
    Set GetSheet = Worksheets(shtName) 

    If GetSheet Is Nothing Then 
     Set GetSheet = Worksheets.Add 
     GetSheet.Name = shtName 
    Else 
     GetSheet.UsedRange.ClearContents 
    End If 
End Function