Vba 到基于多列的自动过滤器

Question

我正在做一个项目，我需要你的帮助

我需要 Vba 代码来根据多列自动过滤和计数项目

例如 我有

所以结果应该是

所有范围以此类推

我尝试了自动过滤，然后为过滤后的数据选择案例代码 并且工作但只是为了另一种观点而不是我正在寻找的观点 选择案例的结果如下

感谢您的支持，请以这种模式获取过滤后的数据

Answer 1

由于您的预期结果令人困惑（如果与图片中的数据进行比较），我不太确定您预期的结果是什么。

无论如何，下面是一个惰性代码，它根据看起来像您图片中的数据创建一个数据透视表。之后，就是一个复制粘贴的过程。

假设您的数据在 sheet1 中，
从单元格 A1 开始，有六个列标题（单元格 A1 到 F1），
F 列之后的左边什么都没有。

Sub test()
Set sh = Sheets("Sheet1")
Set shResult = Sheets("Sheet2")
sh.Range("G:Z").Delete

With sh
Range("C1").Value = "BLANK"
Set rg = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
rg.Offset(0, 6).Value = 1
rg.Resize(rg.Rows.Count, 7).Name = "data"
End With

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "data", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:=sh.Range("P1"), TableName:="ptTmp", DefaultVersion _
        :=xlPivotTableVersion14
        
    With sh.PivotTables("ptTmp").PivotFields("SKU Name")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("Supplier")
        .Orientation = xlRowField
        .Position = 2
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("Inventory Item Status")
        .Orientation = xlRowField
        .Position = 3
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("Flag")
        .Orientation = xlRowField
        .Position = 4
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("FLAG")
        .PivotItems("Used").Visible = False
        .PivotItems("Bad").Visible = False
    End With
    
    With sh.PivotTables("ptTmp")
    .AddDataField ActiveSheet.PivotTables("ptTmp"). _
        PivotFields("1"), "COUNT", xlCount
    .RowAxisLayout xlTabularRow
    .RepeatAllLabels xlRepeatLabels
    .ColumnGrand = False
    .ShowTableStyleRowHeaders = False
    .TableRange1.Copy
    End With

    shResult.Range("A1").PasteSpecial Paste:=xlPasteValues
    shResult.Range("A1").PasteSpecial Paste:=xlPasteFormats
    
        With sh.PivotTables("ptTmp")
            With .PivotFields("FLAG")
            .ClearAllFilters
            .PivotItems("New").Visible = False
            .PivotItems("Bad").Visible = False
            End With
            With .PivotFields("SKU Name")
            Range(.DataRange, .DataRange.Offset(0, 4)).Copy
            End With
        End With
    
    shResult.Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
    
        With sh.PivotTables("ptTmp")
            With .PivotFields("FLAG")
            .ClearAllFilters
            .PivotItems("New").Visible = False
            .PivotItems("Used").Visible = False
            End With
            With .PivotFields("SKU Name")
            Range(.DataRange, .DataRange.Offset(0, 4)).Copy
            End With
        End With

    shResult.Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
    
    sh.Range("G:Z").Delete
    shResult.Activate
    shResult.Range("A1").Select
End Sub