[已解决]二维数组的排序

小线

我还有个思路:

用ADO链接本表用SQL排序后赋值给数组

上清宫主

倒是说出几个，可一个都不会写

还是用e的排方便快捷

小线

QUOTE:

以下是引用上清宫主在2010-5-6 10:26:00的发言：

倒是说出几个，可一个都不会写

还是用e的排方便快捷

可是我连说都不会呢,我只知道冒泡法,好像效率不是很高..

准备慢慢查查看一下这些个算法..谢谢

[em04]

amulee

两个以上关键字原理都是一样的。

Sub 系统排序()
    Dim MyRng As Range
    Set MyRng = Range("A9:A21")
    MyRng.Sort Key1:=MyRng.Cells(1, 1), Order1:=xlAscending, Header:=xlYes, _
        MatchCase:=False, Orientation:=xlSortColumns
End Sub
Sub 冒泡排序()
    Dim i As Integer, Temp As Variant
    Dim arr() As Variant
    Dim OK As Boolean
    arr = Application.Transpose(Range("A10:A21"))
    Do
        OK = True
        For i = UBound(arr) To 2 Step -1
            If arr(i - 1) > arr(i) Then
                Temp = arr(i - 1)
                arr(i - 1) = arr(i)
                arr(i) = Temp
                OK = False
            End If
        Next i
    Loop Until OK
    Range("A10:A21") = Application.Transpose(arr)
End Sub
Sub 选择排序()
    Dim i As Integer, j As Integer
    Dim min As Integer, Temp As Variant
    Dim arr() As Variant
    arr = Application.Transpose(Range("A10:A21"))
    For i = 1 To UBound(arr) - 1
        min = i
        For j = i + 1 To UBound(arr)
            If arr(j) < arr(min) Then min = j
        Next j
        If min <> i Then
            Temp = arr(min)
            arr(min) = arr(i)
            arr(i) = Temp
        End If
    Next i
    Range("A10:A21") = Application.Transpose(arr)
End Sub
Sub 计数排序()
    Dim counts() As Variant, i As Integer, j As Integer
    Dim next_index As Integer
    Dim min_value As Integer, max_value As Integer
    Dim arr() As Variant
    arr = Application.Transpose(Range("A10:A21"))
    min_value = WorksheetFunction.min(arr)
    max_value = WorksheetFunction.max(arr)
    ReDim counts(min_value To max_value)
    For i = 1 To UBound(arr)
        counts(arr(i)) = counts(arr(i)) + 1
    Next i
    next_index = 1
    For i = min_value To max_value
        For j = 1 To counts(i)
            arr(next_index) = i
            next_index = next_index + 1
        Next j
    Next i
    Range("A10:A21") = Application.Transpose(arr)
End Sub
Sub 插入排序()
    Dim i As Integer, j As Integer, Temp As Variant
    Dim arr() As Variant
    arr = Application.Transpose(Range("A10:A21"))
    For i = 1 To UBound(arr)
        Temp = arr(i)
        j = i - 1
        Do
            If j < 1 Then Exit Do
            If arr(j) <= Temp Then Exit Do
            arr(j + 1) = arr(j)
            j = j - 1
        Loop
        If j <> (i - 1) Then arr(j + 1) = Temp
    Next i
    Range("A10:A21") = Application.Transpose(arr)
End Sub
Sub 希尔排序()
    Dim i As Integer, j As Integer
    Dim inc As Integer, Temp As Variant
    Dim arr() As Variant
    arr = Application.Transpose(Range("A10:A21"))
    inc = 1
    Do While inc <= UBound(arr) - 1
        inc = 3 * inc + 1
    Loop
    Do While inc > 1
        inc = inc \ 3
        For i = 1 + inc To UBound(arr)
            Temp = arr(i)
            j = i - inc
            Do
                If j < inc Then Exit Do
                If arr(j) <= Temp Then Exit Do
                arr(j + inc) = arr(j)
                j = j - inc
            Loop
            If j <> (i - inc) Then arr(j + inc) = Temp
        Next
    Loop
    Range("A10:A21") = Application.Transpose(arr)
End Sub
Sub 快速排序(ByRef InputArray As Variant, ByVal lb As Long, ByVal ub As Long)
    Dim Temp As Variant, hi As Integer, low As Integer, i As Integer
    If lb >= ub Then Exit Sub
    i = Int((ub + lb) / 2)
    Temp = InputArray(i)
    InputArray(i) = InputArray(lb)
    lo = lb
    hi = ub
    Do
        Do While InputArray(hi) >= Temp
            hi = hi - 1
            If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            InputArray(lo) = Temp
            Exit Do
        End If
        InputArray(lo) = InputArray(hi)
        lo = lo + 1
        Do While InputArray(lo) < Temp
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
            lo = hi
            InputArray(hi) = Temp
            Exit Do
        End If
        InputArray(hi) = InputArray(lo)
    Loop
    快速排序 InputArray, lb, lo - 1
    快速排序 InputArray, lo + 1, ub
End Sub
Sub 快速排序主程序()
    Dim arr() As Variant
    arr = Application.Transpose(Range("A10:A21"))
    快速排序 arr, 1, UBound(arr)
    Range("A10:A21") = Application.Transpose(arr)
End Sub

amulee

QUOTE:

以下是引用小线在2010-5-6 10:17:00的发言：

我还有个思路:

用ADO链接本表用SQL排序后赋值给数组

SQL其实也蛮好的，速度也不错。在Excel内使用的话，由于要建立对象、读取数据会一定程度上影响速度。

amulee

以前试讲的时候上的就是排序。

一、	优缺点比较
	排序方法	优点	缺点
	系统排序	系统自带，速度较快。	对于只需要VBA内部过程中产生的临时排序数组，由于其在表格内需要进行实际读写，则不适用。 且对于数据量较大时其速度也比较慢。
	冒泡排序法	简单的排序方法，对于小量数据或者接近排序完成的数据速度较快	对于数据量大时排序较慢
	选择排序法	冒泡排序的优化，速度较冒泡排序快	对于数据量大时排序较慢
	快速排序法	适用比较广泛，对于数据量大的随机数据排序较快	对于已经接近排序完成的数据速度不如冒泡排序
	计数排序法	对于特定的数据排序非常快	仅限于数据跨度不大且数据数字不大的整形数据
	插入（希尔）排序法	与冒泡排序类似。 希尔排序作为优化后的插入排序，排序效率比插入排序高。	插入排序的效率同冒泡排序，但对于已经接近排序完成的数据时效率较低。 希尔排序的效率很难讲。
二、	总结
	1、首先要确认所要排序的数据是否需要直接显示在表格内。若是，且数据量不大（10000以内）则推荐系统自 带的排序；否则用以下排序。
	2、如果你的数据列表中有99%数据已排过序，则用冒泡排序法。
	3、如果你要排序的数据较少，则用选择排序法。
	4、如果你的数据都是整数，并且数值不大，则用计数排序法。
	5、上述方法都不适用时，用快速排序法法

小线

哇,好厉害,这下有的学了..[em01]

leolee82

数据多的话就用excel自己的，VBA是解释执行的，不管多优秀的算法，和那些编译过的速度差很多

数据超多EXCEL自带的不能用的话（不知道能不能处理超过总行数的数据）....网上找找，好多现成的，再改下就行了；或者先把二维数组处理成一维的。

如果速度不能满足的话就用编译型语言编译成动态链接库.

我觉得遇到问题灵活处理、运行速度不很慢就好。

小线

谢谢老喵指教,我这也是借机对算法多接触一下,嘻嘻

CCTV20082008

[em17][em17][em17][em17][em17]