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