excel - Excel VBA 根据单元格值过滤掉表格行

Question

我试图根据值从表中排除值。

我有下表，其中包含名称、客户 ID、客户城市和总支出的列：

我想过滤掉以下两个特定值，它们是客户 ID。

为了让茶几看起来像这样，请注意它不再有 Liam Gallagher 或 Tom Johnson。

我知道如何手动过滤掉这些，但我想知道如何在 VBA 上做到这一点？

我已经搜索了互联网，但找不到任何解决方案。此外，这两个表将具有不同的数组，因为客户列表以及客户 ID 可以更改，因此如果可以使其动态化，那就太好了。

谢谢

Answer 1

Sub advanced_filter()
    Dim rgData As Range, rgCriteria As Range, rgOutput As Range
    
    With ThisWorkbook.Worksheets("Sheet 1")
        Set rgData = .Range("A1").CurrentRegion
        Set rgCriteria = .Range("F1").CurrentRegion
        Set rgOutput = .Range("I1")
    
        .Range("I1:L7").ClearContents
    End With
    rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput

End Sub

更新：
F列和G列中的customerID是否
可以垂直堆叠而不是水平堆叠？

您可以使用 vba“手动”执行此操作；-)

Sub advanced_filter()
    Dim rgData As Range, rgCriteria As Range, rgOutput As Range
    
    With ThisWorkbook.Worksheets("Sheet 1")
        Set rgData = .Range("A1").CurrentRegion
        Call CopyTranspose
        Set rgCriteria = .Range("A10").CurrentRegion
        Set rgOutput = .Range("H1")
    
        .Range("H1:L7").ClearContents
    End With
    rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput

End Sub

Sub CopyTranspose()
'
' CopyTranspose Macro
'
    Range("A10:A15").EntireRow.ClearContents

    Dim lineCount As Integer
    lineCount = Range("F1").CurrentRegion.Count
    
    'Transpose Copy
    transposeAndPasteCol Range("F1").CurrentRegion, Range("A11")
    
    Set LastCellRange = Range("B10").Offset(0, lineCount - 2)
    Range("F1").Copy Range(Range("B10"), LastCellRange)

    Range("A10:A20").Delete Shift:=xlToLeft
End Sub

Sub transposeAndPasteCol(ColToCopy As Range, pasteRowTarget As Range)
    pasteRowTarget.Resize(, ColToCopy.Rows.Count) = Application.WorksheetFunction.Transpose(ColToCopy.Value)
End Sub

更新 2：

Sub advanced_filter_V4()
    Dim rgData As Range, rgCriteria As Range, rgOutput As Range
    
    With ThisWorkbook.Worksheets("Sheet 1")
        Set rgData = .Range("A1").CurrentRegion
        Call CopyTranspose
        Set rgCriteria = .Range("A15").CurrentRegion
        Set rgOutput = .Range("F1")
    
        .Range("F1:L7").ClearContents
    End With
    rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput

End Sub

Sub CopyTranspose()
    Range("A15:A20").EntireRow.ClearContents
    transposeAndPasteCol Range("A10:B14"), Range("A15")
End Sub

Sub transposeAndPasteCol(ColToCopy As Range, pasteRowTarget As Range)
    pasteRowTarget.Resize(ColToCopy.Columns.Count, ColToCopy.Rows.Count) _
     = Application.WorksheetFunction.Transpose(ColToCopy.Value)
End Sub