排序級聯組合框的動態值

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