Question

我有一个userform，其中包含一个组合框，该组合框是从工作表列中的唯一项填充的。我正在尝试使用下面的代码按升序对表示组合框中项目的键进行排序，但我得到的是“对象变量或未设置块变量”错误：

Public Function funcSortKeysByLengthDesc(dctList As Object) As Object
Dim curKey As Variant
Dim key As Variant
Dim itX As Integer
Dim itY As Integer
Dim arrTemp() As Variant
Dim d As Object

'Only sort if more than one item in the dict
If dctList.Count > 1 Then

    'Populate the array
    ReDim arrTemp(dctList.Count)
    itX = 0
    For Each curKey In dctList
        arrTemp(itX) = curKey
        itX = itX + 1
    Next

    For itX = 0 To (dctList.Count - 2)
        For itY = (itX + 1) To (dctList.Count - 1)
            If arrTemp(itX) > arrTemp(itY) Then
                curKey = arrTemp(itY)
                arrTemp(itY) = arrTemp(itX)
                arrTemp(itX) = curKey
            End If
        Next
    Next

    'Create the new dictionary
    Set d = CreateObject("Scripting.Dictionary")

    For itX = 0 To UBound(arrTemp)
        d.Add arrTemp(itX), dctList(itX)
    Next

    Set funcSortKeysByLengthDesc = d
Else
    Set funcSortKeysByLengthDesc = dctList
End If
End Function

Answer 1

我不确定您为什么要使用Dicionary执行此任务，但我认为您项目的其他地方需要这样做，所以我＆＃39我试图将我的信息与你现有的代码相吻合。

如果您只是将已排序的单元格放入ComboBox，然后将单元格读入数组，删除重复项并对该数组进行排序，则填充ComboBox会更简单。有很多关于如何在这个网站上完成这些任务的例子，所以我不会在这里重现它们。

以下是您的代码：

Sub RunMe()
    Dim ws As Worksheet
    Dim rCell As Range
    Dim dctItem As String
    Dim dctArray() As String
    Dim i As Integer
    Dim d As Object
    Dim v As Variant

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'Code to poulate a few "C" cells
    ws.Cells(3, "C").Resize(10).Value = Application.Transpose(Array("Z", "Y", "X", "W", "W", "E", "D", "C", "B", "A"))
    UserForm1.Show False

    'Clear the combobox
    UserForm1.cbNames.Clear

    'Create the dictionary
    Set d = CreateObject("Scripting.Dictionary")
    For Each rCell In ws.Range("C3", ws.Cells(Rows.Count, "C").End(xlUp))
        dctItem = CStr(rCell.Value2)
        If Not d.Exists(dctItem) Then
            d.Add dctItem, dctItem
        End If
    Next

    'Convert the dictionary items to an array
    Debug.Print "PRE-SORT"
    ReDim dctArray(1 To d.Count)
    i = 1
    For Each v In d.Items
        dctArray(i) = v
        i = i + 1
        Debug.Print v
    Next

    'Bubble sort the array
    dctArray = BubbleSort(dctArray)

    'Populate the dictionary and combobox
    Debug.Print "POST-SORT"
    Set d = CreateObject("Scripting.Dictionary")
    For i = LBound(dctArray) To UBound(dctArray)
        d.Add dctArray(i), dctArray(i)
        UserForm1.cbNames.AddItem dctArray(i)
        Debug.Print dctArray(i)
    Next

End Sub
Private Function BubbleSort(tempArray As Variant) As Variant
    'Uses Microsoft's version: https://support.microsoft.com/en-us/kb/133135
    Dim temp As Variant
    Dim i As Integer
    Dim noExchanges As Integer

    ' Loop until no more "exchanges" are made.
    Do
        noExchanges = True

        ' Loop through each element in the array.
        For i = 1 To UBound(tempArray) - 1

            ' If the element is greater than the element
            ' following it, exchange the two elements.
            If tempArray(i) > tempArray(i + 1) Then
                noExchanges = False
                temp = tempArray(i)
                tempArray(i) = tempArray(i + 1)
                tempArray(i + 1) = temp
            End If
        Next i
    Loop While Not (noExchanges)

    BubbleSort = tempArray

End Function

通过升序键值排序字典时出错

1 个答案: