在VBA中排序数组

时间:2017-08-22 17:56:49

标签: vba excel-vba sorting excel

我有一个182.123大小的数组,我想根据数组类的特定属性对它们进行排序。该类被称为CFlujo,我想要对它们进行排序的属性是一个名为id_flujo的字符串。到目前为止,我正在做这样的泡泡排序,但这只需要太长时间:

Sub sort_arreglo(arreglo As Variant)
For x = LBound(arreglo) To UBound(arreglo)
For y = x To UBound(arreglo)
    Dim aux As CFlujo
    aux = New CFlujo
  If UCase(arreglo(y).id_flujo) < UCase(arreglo(x).id_flujo) Then
    Set aux = arreglo(y)
    Set arreglo(y) = arreglo(x)
    Set arreglo(x) = aux
  End If
 Next y
Next x
End Sub

到目前为止,我已对Selection Sort进行了研究,但我知道您无法从数组中删除项目,因此我无法制作两个列表来将值从一个列表排序到另一个。我可以将我的数据放入集合中,但我在数据质量方面遇到了麻烦,除非我预先分配内存(比如在数组中)。

1 个答案:

答案 0 :(得分:4)

您可以采取以下措施来缩短执行时间:

  • 加载数组中的所有属性
  • 排序一些指针而不是对象
  • 使用更好的算法,例如QucikSort

以你为例:

Sub Sort(arreglo As Variant)
  Dim cache, vals(), ptrs() As Long, i As Long

  ReDim vals(LBound(arreglo) To UBound(arreglo))
  ReDim ptrs(LBound(arreglo) To UBound(arreglo))

  ' load the properties and fill the pointers
  For i = LBound(arreglo) To UBound(arreglo)
    vals(i) = UCase(arreglo(i).id_flujo)
    ptrs(i) = i
  Next

  ' sort the pointers
  QuickSort vals, ptrs, 0, UBound(vals)

  ' make a copy
  cache = arreglo

  ' set the value for each pointer
  For i = LBound(arreglo) To UBound(arreglo)
    Set arreglo(i) = cache(ptrs(i))
  Next
End Sub


Private Sub QuickSort(vals(), ptrs() As Long, ByVal i1 As Long, ByVal i2 As Long)
  Dim lo As Long, hi As Long, p As Long, tmp As Long
  lo = i1
  hi = i2
  p = ptrs((i1 + i2) \ 2)

  Do
    While vals(ptrs(lo)) < vals(p): lo = lo + 1: Wend
    While vals(ptrs(hi)) > vals(p): hi = hi - 1: Wend

    If lo <= hi Then
      tmp = ptrs(hi)
      ptrs(hi) = ptrs(lo)
      ptrs(lo) = tmp
      lo = lo + 1
      hi = hi - 1
    End If
  Loop While lo <= hi

  If i1 < hi Then QuickSort vals, ptrs, i1, hi
  If lo < i2 Then QuickSort vals, ptrs, lo, i2
End Sub