excel vba过滤和分组

时间:2015-12-10 08:27:14

标签: excel vba excel-vba filtering grouping

我在excel中有这张表,我需要应用AutoFilter

假设“合同”在A1列开始,B1在“评论”开始。见下面的例子:

Contract    Comment
111         A
111         b
111         c
222         d
222         f
222         g
333         d
333         f
333         A
444         b
444         d
444         c

我想过滤合同以显示合同组/合同组(合同组/合同组的示例为111),其中该组/组中的任何合同都有评论A.见下文:

注意:我有一些与我的应用程序相关的其他数据,但在此示例中未显示。

Contract    Comment
111         A
111         b
111         c
333         d
333         f
333         A

而且我希望能够通过任何不包含“A”的评论进行过滤。结果应如下:

Contract    Comment
222         d
222         f
222         g
444         b
444         d
444         c

1 个答案:

答案 0 :(得分:0)

这将自动过滤合约列到合约集合,该集合中的任何合约都有A的评论。

要过滤掉您需要添加<>的值在Array中的文本之前,这似乎不起作用。因此,我在末尾添加了一个循环来遍历行manuall并查看COntract值是否在ContainsA数组中,如果它们是隐藏行。

Sub SomeSub()

    Dim MyRange As Range, CommentRng As Range, ContractRng As Range
    Dim ContainA As Variant
    Dim i As Integer, k As Integer, r As Integer

    'Getting the Total Rows of the Sheet
    With ActiveSheet.UsedRange
        LastRow = .Rows(.Rows.Count).Row
    End With

    'Setting the USedRange of the Sheet
    Set MyRange = ActiveWorkbook.ActiveSheet.UsedRange

    'Setting the Comment and Contract Ranges
    Set CommentRng = ActiveWorkbook.ActiveSheet.Range(Cells(1, 2), Cells(LastRow, 2))
    Set ContractRng = ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 1))

    'Filtering the Comment Column
    MyRange.AutoFilter Field:=2, Criteria1:="A"

    'Getting the number of visible cells in the Contract Range
    ' -1 to remove the First Row of the Comment headin
    ' -1 to set Array correctly, it Array(1) then the array( SomeValue, SomeOtherValue)
    TotalA = ContractRng.SpecialCells(xlCellTypeVisible).Count - 2

    'Setting the Array size
    ReDim ContainA(TotalA)
    'Setting the Array size
    ReDim NotContainA(TotalA)

    i = 0
    'For each visible cell in Column 2 "Comment"
    For Each cell In ContractRng.SpecialCells(xlCellTypeVisible)

        'If the Value is "Comment"
        If cell.Value = "Contract" Then

            'Do nothing

        Else
            'Set the Cell value into the Array
            ContainA(i) = cell
            'Increment i
            i = i + 1
        End If

    Next cell


    ActiveSheet.ShowAllData


    'Filitering the Column 1 Data, the Criteria1 needs to be a string Array
    'Join(Array1) joins the Array as a String
    'Split then splits the String as a String array
    MyRange.AutoFilter Field:=1, Criteria1:=Split(Join(ContainA)), Operator:=xlFilterValues



    ActiveSheet.ShowAllData

    'If you want to hide the groups which contain "A"
    'There is no "FILTEROUT" function
    'so this must be done manually
    For r = 1 To LastRow

        For k = 0 To TotalA

            If Cells(r, 1) = ContainA(k) Then

                Rows(r).EntireRow.Hidden = True

            End If

        Next k

    Next r

End Sub