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

Question

好吧，这个很难解释 - 我有一个非常大的 table，其中包含客户、零件号、价格和收入。我需要 return 所有使用零件号列表的客户；因此，例如，如果他们使用零件 ABC 和 DEF，那么它将 return 使用这些零件的客户，以及这些客户的收入（我想我会将整行复制到另一个 table 或其他东西） .

我不想看到客户只用一个零件而不用另一个零件。我试过自动过滤器和高级过滤器，但没有成功，但如果可能的话，我宁愿在 VBA 中这样做。我不确定哪种方式最简单...

一个想法是旋转 table 并按客户排序，但这是非常手动的，我需要将这些结果拉入另一个 table 以便我可以单独查看数据。非常感谢任何帮助！

示例table

Answer 1

编辑在 OP 澄清后。查看添加的代码

您可以使用 "Range" "AutoFilter()" 方法的 "xlFilterValues" 运算符 object。

假设第一行有 headers，这是您要求的 "basic concepts" 代码：

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() 来捕获共享所有列出部分的适当客户，但是将这项工作留给字典并使用 AutoFilter() 作为最终的 [=29] 会更有效=] 部分。如下：

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

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

Excel VBA - Trying to return values that that only contain all criteria

indexing

excel

vba

pivot

autofilter

示例table