1

我正在 Excel 中创建一个报告，我有 3 列数据（学院、部门、部门）和 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
4

1 回答 1

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
于 2013-04-24T14:19:23.907 回答