Question

Excel VBA 按条件排序

如图，A列和B列的每个单元格均为任意字符串(这里是随便举的例子)。
程序的用户窗体是这样的：

在程序开始时，在第一个下拉菜单里面列出A列所有不重复的字符串(例如这里面就有三个选项，ABC，BCD和XYZ)。
想要实现的是，用户选择A列任一单元格中的字符串(例如选择"ABC")。然后程序在第二个下拉菜单中列出B列中与选择的字符串相对应的不重复字符串(这时B列应有选项12和123)。
假设用户此时选择"123"，然后点击了CommandButton1。程序对工作表进行排序，把符合条件的行置于工作表最上方(在这个例子中就是第2行和第5行分别变成了第1和第2行。其它行顺序不变，依次顺延。
这样的程序要怎么写？写代码或者上传附件都可以。谢谢！





Answer 1

所有代码如下：

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

详见附件：

追问

能不能直接在A，B两列做改动啊。不要在E和D排序。

追答

当然可以，我只是害怕损坏你的数据，所以把数据输出到了D.E列。如果要在A,B列显示，只需修改下面的代码即可：

    With Sheet1
        .Cells(1, "D").Resize(n, 2) = WorksheetFunction.Transpose(brr)
        .Cells(n + 1, "D").Resize(m, 2) = WorksheetFunction.Transpose(crr)
    End With

将.cells(i,"D")和.cells(n+1,"D")里面的D改成A即可。如下：

    With Sheet1
        .Cells(1, "A").Resize(n, 2) = WorksheetFunction.Transpose(brr)
        .Cells(n + 1, "A").Resize(m, 2) = WorksheetFunction.Transpose(crr)
    End With