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

时间:2014-11-17 17:31:38

标签: excel vba multidimensional-array bubble-sort

我一直在敲打我的脑袋(以及其他一些Excel编程网站上的其他脑袋)来获取Userform中的Combobox,以按字母顺序对行(来自源电子表格中的两列)进行排序。

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

目前,Combobox在放下时会读取部分内容(减去不出现且不需要的子弹点):

  
      
  • 放大MRKPayoutPlan
  •   
  • Chuck PSERSFuture
  •   
  • Chuck PSERSCurrent
  •   

我想要的是:

  
      
  • Chuck PSERSCurrent
  •   
  • Chuck PSERSFuture
  •   
  • 放大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

1 个答案:

答案 0 :(得分:0)

以下是VBA source中的冒泡排序。

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