Excel VBA 按条件排序

所有代码如下：

Private Sub ComboBox1_Change()   '第一个组合框变化
    Dim dc As Object
    Set dc = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    ComboBox2.Clear
    With Sheet1
        For i = 1 To .[a65536].End(3).Row
            If .Cells(i, 1) = ComboBox1.Value Then
                If Not dc.exists(.Cells(i, 2).Value) Then
                    ComboBox2.AddItem .Cells(i, 2).Value
                    dc.Add Sheet1.Cells(i, 2).Value, i
                End If
            End If
        Next
    End With
    ComboBox2.Value = ComboBox2.List(0)
End Sub

Private Sub UserForm_Initialize()    '窗体初始化
    Dim dc As Object
    Set dc = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 1 To Sheet1.[a65536].End(3).Row
        If Not dc.exists(Sheet1.Cells(i, 1).Value) Then
            ComboBox1.AddItem Sheet1.Cells(i, 1).Value
            dc.Add Sheet1.Cells(i, 1).Value, i
        End If
    Next
    ComboBox1.Value = Sheet1.Cells(1, 1).Value
End Sub

Private Sub CommandButton1_Click()    '排序按钮
    Dim arr, brr(), crr()
    arr = Sheet1.Range("A1:B" & Sheet1.[a65536].End(3).Row).Value
    Dim i As Long, m As Long, n As Long
    For i = 1 To UBound(arr)
        If arr(i, 1) & arr(i, 2) = ComboBox1.Value & ComboBox2.Value Then
            n = n + 1
            ReDim Preserve brr(1 To 2, 1 To n)
            brr(1, n) = arr(i, 1)
            brr(2, n) = arr(i, 2)
        Else
            m = m + 1
            ReDim Preserve crr(1 To 2, 1 To m)
            crr(1, m) = arr(i, 1)
            crr(2, m) = arr(i, 2)
        End If
    Next
    With Sheet1
        .Cells(1, "D").Resize(n, 2) = WorksheetFunction.Transpose(brr)
        .Cells(n + 1, "D").Resize(m, 2) = WorksheetFunction.Transpose(crr)
    End With
End Sub

详见附件：