我在Excel中创建一个报告，我有3列数据（学院，部门，部门）和3个相应的级联组合框（类似分层的查找）。当用户从第一个组合框中选择College时，第二个组合框仅显示与该College相关联的Divisions，而第三个组合框仅显示与该Division相关联的Departments。
我无法弄清楚如何将第2和第3个动态组合框中的值按字母顺序排序。例如，当用户选择学院时，我希望将分区显示（在ComboBox2中）为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
答案 0 :(得分：0)
这里有一些代码可以将整个范围读入模块级数组变量，然后使用它和字典进行过滤和排序。
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