[已解决]【求教】对一维数组排序

xdwy81129

【求教】对一维数组排序

情况有2种：

第1种是数字没有空值的排序

第2中有空值的排序，非空值排前面

请老师分别解答2种情况，同时请指明下改变什么地方得升序或者降序。

最佳答案

月排行榜 / 总排行榜

amulee

2010-4-9 13:26

编了一个函数，采用冒泡排序。

Sub Test()
    Arr = Array(1, 4, 3, 2, "", "", "")
    MsgBox Join(排序(Arr, "JX"), ",")
End Sub

Function 排序(ByVal Arr, ByVal Order)
    Dim i&, j&, Temp As Variant
    Dim OK As Boolean
    '先把所有的空值排到前面
    j = UBound(Arr)
    i = LBound(Arr)
    Do
        Do While Len(Arr(j)) > 0 And i < j
            j = j - 1
        Loop
        If i < j Then
            Do While Len(Arr(i)) = 0 And i < j
                i = i + 1
            Loop
        End If
        If i < j Then
            Temp = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Temp
        End If
    Loop Until i = j
    '排序
    If j > LBound(Arr) Then j = j + 1
    If Order = "SX" Then '升序
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    Else
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    End If
    排序 = Arr
End Function

跳转到最佳答案楼层

开辆小富康

数组排序要自己编

上清宫主

利用单元格过渡，最快

小线

排序好像是冒泡算法?

amulee

编了一个函数，采用冒泡排序。

Sub Test()
    Arr = Array(1, 4, 3, 2, "", "", "")
    MsgBox Join(排序(Arr, "JX"), ",")
End Sub

Function 排序(ByVal Arr, ByVal Order)
    Dim i&, j&, Temp As Variant
    Dim OK As Boolean
    '先把所有的空值排到前面
    j = UBound(Arr)
    i = LBound(Arr)
    Do
        Do While Len(Arr(j)) > 0 And i < j
            j = j - 1
        Loop
        If i < j Then
            Do While Len(Arr(i)) = 0 And i < j
                i = i + 1
            Loop
        End If
        If i < j Then
            Temp = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Temp
        End If
    Loop Until i = j
    '排序
    If j > LBound(Arr) Then j = j + 1
    If Order = "SX" Then '升序
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    Else
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    End If
    排序 = Arr
End Function

xdwy81129

QUOTE:

以下是引用amulee在2010-4-9 13:26:00的发言：

编了一个函数，采用冒泡排序。

Sub Test()
    Arr = Array(1, 4, 3, 2, "", "", "")
    MsgBox Join(排序(Arr, "JX"), ",")
End
  Sub

Function 排序(ByVal Arr, ByVal Order)
    Dim i&, j&, Temp As
  Variant
    Dim OK As
  Boolean
    '先把所有的空值排到前面
    j = UBound(Arr)
    i = LBound(Arr)
    Do
        Do
  While Len(Arr(j)) > 0 And i < j
            j = j - 1
        Loop
        If i < j Then
            Do
  While Len(Arr(i)) = 0 And i < j
                i = i + 1
            Loop
        End
  If
        If i < j Then
            Temp = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Temp
        End
  If
    Loop
  Until i = j
    '排序
    If j > LBound(Arr) Then j = j + 1
    If Order = "SX" Then
  '升序
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    Else
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    End
  If
    排序 = Arr
End
  Function

呀，好复杂呀。升序怎么排呢？？？

没有空值的情况，宏可以简单些吗？？？

amulee

函数如下：

Arr=排序(Arr, "JX")

第一个参数输入数组，第二个参数为升序"SX"或降序"JX"

该函数已经考虑了空值和非空值的两种情况了。

xdwy81129

QUOTE:

以下是引用amulee在2010-4-9 15:14:00的发言：

函数如下：

Arr=排序(Arr, "JX")

第一个参数输入数组，第二个参数为升序"SX"或降序"JX"

该函数已经考虑了空值和非空值的两种情况了。

我就想，如果不考虑空值，可能速度更快些，而且宏也比较简单。

再望赐教

amulee

Function 排序(ByVal Arr, ByVal Order)
    Dim i&, j&, Temp As Variant
    Dim OK As Boolean
    j = LBound(Arr)
    '排序
    If Order = "SX" Then '升序
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    Else
        Do
            OK = True
            For i = UBound(Arr) To j + 1 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
    End If
    排序 = Arr
End Function

amulee

对于小量数据，这个其实挺快了。再快也快不了多少。