Fork me on GitHub

VBA中的数组排序

      在Excel中没有提供直接的方法或函数用于数组排序,因此若要使用VBA进行数组排序,则需要采用我们在数据结构与算法课程中学到的排序算法。

      这里转载了Using a Visual Basic Macro to Sort Arrays in Microsoft Excel中给出的使用VBA进行数组排序的两种方法,分别采用的排序算法为:选择排序和冒泡排序。

Method 1: Selection Sort

      Function SelectionSort(TempArray As Variant)
          Dim MaxVal As Variant
          Dim MaxIndex As Integer
          Dim i, j As Integer

          ' Step through the elements in the array starting with the
          ' last element in the array.
          For i = UBound(TempArray) To 1 Step -1

              ' Set MaxVal to the element in the array and save the
              ' index of this element as MaxIndex.
              MaxVal = TempArray(i)
              MaxIndex = i

              ' Loop through the remaining elements to see if any is
              ' larger than MaxVal. If it is then set this element
              ' to be the new MaxVal.
              For j = 1 To i
                  If TempArray(j) > MaxVal Then
                      MaxVal = TempArray(j)
                      MaxIndex = j
                  End If
              Next j

              ' If the index of the largest element is not i, then
              ' exchange this element with element i.
              If MaxIndex < i Then
                  TempArray(MaxIndex) = TempArray(i)
                  TempArray(i) = MaxVal
              End If
          Next i

      End Function

      Sub SelectionSortMyArray()
          Dim TheArray As Variant

          ' Create the array.
          TheArray = Array("one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten")

          ' Sort the Array and display the values in order.
          SelectionSort TheArray
          For i = 1 To UBound(TheArray)
              MsgBox TheArray(i)
          Next i

      End Sub

Method 2: Bubble Sort

      Function BubbleSort(TempArray As Variant)
          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)

      End Function

      Sub BubbleSortMyArray()
          Dim TheArray As Variant

          ' Create the array.
          TheArray = Array(15, 8, 11, 7, 33, 4, 46, 19, 20, 27, 43, 25, 36)

          ' Sort the Array and display the values in order.
          BubbleSort TheArray
          For i = 1 To UBound(TheArray)
              MsgBox TheArray(i)
          Next i
      End Sub

posted on 2011-10-19 23:12  RussellLuo  阅读(16224)  评论(0编辑  收藏  举报

导航