Excel VBA 数组中的 2D 气泡排序的运行时错误

Question

我一直在努力（以及其他一些 Excel 编程站点上的头）让用户表单中的组合框按字母顺序对行（来自源电子表格中的两列）进行排序。

理想情况下，我想要二维排序，但在这一点上，将满足于一个有效的排序。

目前，组合框在下拉时部分读取（减去项目符号点，这些项目符号不会出现且不需要）：

• Zoom MRKPayoutPlan
• 查克·普瑟斯
• 查克·

我想要的是：

• 查克·
• 查克·普瑟斯
• Zoom MRKPayoutPlan

第一个顺序派生自行在源工作表中的显示顺序。

此时，我收到运行时错误"13"，类型不匹配错误。两个字段都是文本字段（一个是姓氏，另一个是分类代码 - 我想先按名称排序）。

以下是VBA代码的两个相关部分。如果有人能帮我解决这个问题，我至少会买一轮虚拟的啤酒。Excel VBA 不是我最舒适的领域 - 我可以在其他应用程序中完成此操作，但客户端规范是这一切都必须在 Excel 中单独运行。提前谢谢。

Private Sub UserForm_Initialize()
   fPath = ThisWorkbook.Path & ""
   currentRow = 4
   sheetName = Sheet5.Name
   lastRow = Sheets(sheetName).Range("C" & Rows.Count).End(xlUp).Row

    Dim rngUID As Range
    Dim vList
    Set rngUID = Range("vUID")
    With rngUID
        vList = Application.Index(.Cells, .Parent.Evaluate("ROW(" & .Address & ")"), Array(7, 1))
    End With
   vList = BubbleSort2D(vList, 2, 1)
    With ComboBox1
        .ColumnCount = 2
        .ColumnWidths = "100;100"
        .List = vList
    End With
   PopulateControls
End Sub
Public Function BubbleSort2D(Strings, ParamArray SortColumns())
    Dim tempItem
    Dim a                     As Long
    Dim e                     As Long
    Dim f                     As Long
    Dim g                     As Long
    Dim i                     As String
    Dim j                     As String
    Dim m()                   As String
    Dim n
    Dim x As Long
    Dim y As Long
    Dim lngColumn As Long

    e = 1
    n = Strings
    Do While e <> -1
        For a = LBound(Strings) To UBound(Strings) - 1
            For y = LBound(SortColumns) To UBound(SortColumns)
                lngColumn = SortColumns(y)
                i = n(a, lngColumn)
                j = n(a + 1, lngColumn)
                f = StrComp(i, j)
                If f < 0 Then
                    Exit For
                ElseIf f > 0 Then
                    For x = LBound(Strings, 2) To UBound(Strings, 2)
                        tempItem = n(a, x)
                        n(a, x) = n(a + 1, x)
                        n(a + 1, x) = tempItem
                    Next x
                    g = 1
                    Exit For
                End If
            Next y
        Next a
        If g = 1 Then
            e = 1
        Else
            e = -1
        End If
        g = 0
    Loop
    BubbleSort2D = n
End Function

Answer 1

这是VBA源中的气泡排序。

Public Sub BubbleSort(ByRef sequence As Variant, _
        ByVal lower As Long, ByVal upper As Long)
    Dim upperIt As Long
    For upperIt = upper To lower + 1 Step -1
        Dim hasSwapped As Boolean
        hasSwapped = False
        Dim bubble As Long
        For bubble = lower To upperIt - 1
            If sequence(bubble) > sequence(bubble + 1) Then
                Dim t as Variant
                t = sequence(bubble)
                sequence(bubble) = sequence(bubble + 1)
                sequence(bubble + 1) = t
                hasSwapped = True
            End If
        Next bubble
        If Not hasSwapped Then Exit Sub
    Next upperIt
End Sub

请注意，使用指定它们是什么和作用的变量名称而不是单个字母可以使其更易于阅读。

至于2D排序。不要。 单独对每个数组进行排序，然后使用相同的方法对数组数组进行排序。 您需要提供一个抽象来比较列。不要尝试同时对它们进行排序。 我想不出这是一个好主意的情况。 如果由于某种原因元素可以更改其在 2D 数组中的子数组，然后将其展平为 1 个数组，对其进行排序并将其拆分回 2D 数组。

老实说，从我对你的具体问题的了解来看。 您正在从 1D 序列转到 1D 序列，所以我认为 2D 数组是不必要的复杂性。

而是将修改后的气泡排序例程与比较语句一起使用，

 If sequence(bubble) > sequence(bubble +1) Then '...

替换为自定义比较功能

ComboBoxItemCompare(sequence(bubble), sequence(bubble + 1))

这将返回True如果第一个参数应该与第二个参数交换。