排序级联组合框的动态值

Question

我在Excel中创建了一个报表，并且我有3列数据（College，Division，Department）以及3个对应的级联组合框（类似分层的查找）。当用户从第一个组合框中选择College时，第二个组合框仅显示与该学院相关的分部，而第三个组合框仅显示与该分部相关联的部门。

我无法弄清楚如何将第二个和第三个动态组合框中的值按字母顺序排序。例如，当用户选择一所学院时，我希望将分部显示为（在组合框2中）A_Division，B_Division，...，Z_Division（而现在该分部按照它在工作表上的顺序显示）。如果可能的话，我想避免排序原始数据并动态地对数组进行排序。

下面是一些大量借来的代码（有我的一些评论）。任何帮助将不胜感激。

Private Sub userform_initialize() 

Dim x 

Set dic = CreateObject("Scripting.Dictionary") 

With Sheets("source_data") 
    For Each r In .Range("A22", .Range("A65536").End(xlUp)) 
     If Not IsEmpty(r) And Not dic.exists(r.value) Then 
      dic.add r.value, Nothing 
     End If 
    Next 
End With 

x = dic.keys 

QuickSort x 'this only sorts the contents of ComboBox1, can I apply it to ComboBox2 & ComboBox3? 

Me.ComboBox1.List = x 

End Sub 

Private Sub ComboBox1_Change() 

Me.ComboBox2.Clear: Me.ComboBox2.Clear 
Me.ComboBox2.value = ("Choose Division") 

Set dic = CreateObject("Scripting.dictionary") 
    With Sheets("source_data") 
     For Each r In .Range("A22", .Range("A65536").End(xlUp)) 
      If r = Me.ComboBox1.value Then 
       If Not dic.exists(r.Offset(, 1).value) Then 
        Me.ComboBox2.AddItem r.Offset(, 1) 
        dic.add r.Offset(, 1).value, Nothing 
       End If 
      End If 
     Next 
    End With 

'Can I sort here? 

    With Me.ComboBox2 
     If .ListCount = 1 Then .ListIndex = 0 
    End With 

End Sub 

Private Sub ComboBox2_Change() 

Me.ComboBox3.Clear: Me.ComboBox3.Clear 
Me.ComboBox3.value = ("Choose Department") 

Set dic = CreateObject("Scripting.dictionary") 
    With Sheets("source_data") 
     For Each r In .Range("B22", .Range("B65536").End(xlUp)) 
      If r = Me.ComboBox2.value Then 
       If Not dic.exists(r.Offset(, 1).value) Then 

        Me.ComboBox3.AddItem r.Offset(, 1) 
        dic.add r.Offset(, 1).value, Nothing 

       End If 
      End If 
     Next 
    End With 

    'Can I sort here? 

    With Me.ComboBox3 
     If .ListCount = 1 Then .ListIndex = 0 
    End With 

End Sub 


Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_high1) 
    On Error Resume Next 

    'Dimension variables 
    Dim V_Low2, V_high2, V_loop As Integer 
    Dim V_val1, V_val2 As Variant 

    'If first time, get the size of the array to sort 
    If IsMissing(V_Low1) Then 
     V_Low1 = LBound(VA_array, 1) 
    End If 

    If IsMissing(V_high1) Then 
     V_high1 = UBound(VA_array, 1) 
    End If 

    'Set new extremes to old extremes 
    V_Low2 = V_Low1 
    V_high2 = V_high1 

    'Get value of array item in middle of new extremes 
    V_val1 = VA_array((V_Low1 + V_high1)/2) 

    'Loop for all the items in the array between the extremes 
    While (V_Low2 <= V_high2) 

     'Find the first item that is greater than the mid-point item 
     While (VA_array(V_Low2) < V_val1 And V_Low2 < V_high1) 
      V_Low2 = V_Low2 + 1 
     Wend 

     'Find the last item that is less than the mid-point item 
     While (VA_array(V_high2) > V_val1 And V_high2 > V_Low1) 
      V_high2 = V_high2 - 1 
     Wend 

     'If the new 'greater' item comes before the new 'less' item, swap them 
     If (V_Low2 <= V_high2) Then 
      V_val2 = VA_array(V_Low2) 
      VA_array(V_Low2) = VA_array(V_high2) 
      VA_array(V_high2) = V_val2 

      'Advance the pointers to the next item 
      V_Low2 = V_Low2 + 1 
      V_high2 = V_high2 - 1 
     End If 
    Wend 

    'Iterate to sort the lower half of the extremes 
    If (V_high2 > V_Low1) Then Call QuickSort(VA_array, V_Low1, V_high2) 

    'Iterate to sort the upper half of the extremes 
    If (V_Low2 < V_high1) Then Call QuickSort(VA_array, V_Low2, V_high1) 
End Sub 

Answer 1

这里的一些代码，将读出的整个范围划分为模块级数组变量，然后使用该和字典来过滤和排序。

Private mvaValues As Variant 
Private mbEventsDisabled As Boolean 

Private Sub userform_initialize() 

    Dim scDic As Scripting.Dictionary 
    Dim vaKeys As Variant 
    Dim i As Long 

    Set scDic = New Scripting.Dictionary 

    'Read the whole range into a module level variable 
    With Sheets("source_data") 
     mvaValues = .Range("A22", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Value 
    End With 

    'Put uniques in a dictionary 
    For i = LBound(mvaValues, 1) To UBound(mvaValues, 1) 
     If Not scDic.Exists(mvaValues(i, 1)) Then 
      scDic.Add mvaValues(i, 1), Nothing 
     End If 
    Next i 

    'Grab the keys and sort 
    vaKeys = scDic.Keys 
    QuickSort vaKeys, LBound(vaKeys), UBound(vaKeys) 

    'Put the sorted keys into the combobox 
    Me.ComboBox1.List = vaKeys 

End Sub 

Private Sub ComboBox1_Change() 

    Dim scDic As Scripting.Dictionary 
    Dim i As Long 
    Dim vaKeys As Variant 

    If Not mbEventsDisabled Then 
     Set scDic = New Scripting.Dictionary 

     mbEventsDisabled = True 
      For i = LBound(mvaValues, 1) To UBound(mvaValues, 1) 
       If mvaValues(i, 1) = Me.ComboBox1.Value Then 
        If Not scDic.Exists(mvaValues(i, 2)) Then 
         scDic.Add mvaValues(i, 2), Nothing 
        End If 
       End If 
      Next i 

      vaKeys = scDic.Keys 
      QuickSort vaKeys, LBound(vaKeys), UBound(vaKeys) 

      Me.ComboBox2.Clear 
      Me.ComboBox2.List = vaKeys 

      If LBound(vaKeys) = UBound(vaKeys) Then 
       mbEventsDisabled = False 
       Me.ComboBox2.ListIndex = 0 
      Else 
       Me.ComboBox2.Value = ("Choose Division") 
      End If 

     mbEventsDisabled = False 
    End If 

End Sub 

Private Sub ComboBox2_Change() 

    Dim scDic As Scripting.Dictionary 
    Dim i As Long 
    Dim vaKeys As Variant 

    If Not mbEventsDisabled Then 
     Set scDic = New Scripting.Dictionary 

     mbEventsDisabled = True 
      For i = LBound(mvaValues, 1) To UBound(mvaValues, 1) 
       If mvaValues(i, 1) = Me.ComboBox1.Value And mvaValues(i, 2) = Me.ComboBox2.Value Then 
        If Not scDic.Exists(mvaValues(i, 3)) Then 
         scDic.Add mvaValues(i, 3), Nothing 
        End If 
       End If 
      Next i 

      vaKeys = scDic.Keys 
      QuickSort vaKeys, LBound(vaKeys), UBound(vaKeys) 

      Me.ComboBox3.Clear 
      Me.ComboBox3.List = vaKeys 

      If LBound(vaKeys) = UBound(vaKeys) Then 
       Me.ComboBox3.ListIndex = 0 
      Else 
       Me.ComboBox3.Value = ("Choose Division") 
      End If 

     mbEventsDisabled = False 
    End If 

End Sub 

Public Sub QuickSort(ByRef vArray As Variant, lLow As Long, lHigh As Long) 

    Dim vPivot As Variant 
    Dim vSwap As Variant 
    Dim lTmpLow As Long 
    Dim lTmpHigh As Long 

    lTmpLow = lLow 
    lTmpHigh = lHigh 

    vPivot = vArray((lLow + lHigh) \ 2) 

    Do While lTmpLow <= lTmpHigh 

     Do While vArray(lTmpLow) < vPivot And lTmpLow < lHigh 
      lTmpLow = lTmpLow + 1 
     Loop 

     Do While vPivot < vArray(lTmpHigh) And lTmpHigh > lLow 
      lTmpHigh = lTmpHigh - 1 
     Loop 

     If lTmpLow < lTmpHigh Then 
      vSwap = vArray(lTmpLow) 
      vArray(lTmpLow) = vArray(lTmpHigh) 
      vArray(lTmpHigh) = vSwap 
     End If 

     If lTmpLow <= lTmpHigh Then 
      lTmpLow = lTmpLow + 1 
      lTmpHigh = lTmpHigh - 1 
     End If 

    Loop 

    If lLow < lTmpHigh Then QuickSort vArray, lLow, lTmpHigh 
    If lTmpLow < lHigh Then QuickSort vArray, lTmpLow, lHigh 

End Sub