余小章 @ 大內殿堂

Option Explicit

Option Base 1 '訂義陣列起始數為1,不能為0,因為在excel儲存格沒有0的定義位置

Dim counts()

Dim RepCell() '重複數值

Dim RepNo() '重複數量

Dim RepCon As Long

Dim i As Long

Dim j As Long

Dim next_index As Variant

Dim min, max

Dim min_value As Variant, max_value As Variant

Sub mySort()

    Dim i As Long

    Dim StartT As Date

    Dim myArray(65535) As Long '定義陣列數量

    StartT = Timer

    For i = 1 To 65535

        myArray(i) = CLng(Rnd * 100000) '

    Next i

    '測試用陣列

    '=======================================

    '    Dim myArray()

    '    myArray = Array(5, 1, 1, 5, 3, 6, 1)

    '=======================================

    Cells.Clear

    Application.ScreenUpdating = False

    DoEvents

    Range("A1").Value = "隨機數字 " & Format(Timer - StartT, "00.00") & " sec."

    Range(Cells(2, 1), Cells(UBound(myArray) + 1, 1)) = Application.Transpose(myArray) '未排列

    StartT = Timer

    Call Countingsort(myArray)

    Range("B1").Value = "由小到大 " & Format(Timer - StartT, "00.00") & " sec."

    Range(Cells(2, 2), Cells(UBound(myArray) + 1, 2)) = Application.Transpose(myArray) '由小到大

    StartT = Timer

    Call Countingsort1(myArray)

    Range(Cells(2, 3), Cells(UBound(myArray) + 1, 3)) = Application.Transpose(myArray) '由大到小

    Range("C1").Value = "由大到小 " & Format(Timer - StartT, "00.00") & " sec."

End Sub

Sub Countingsort(list) '由小到大

    min_value = Minimum(list) '比出最小值

    max_value = Maximum(list) '比出最大值

    min = LBound(list) '陣列最小數量

    max = UBound(list) '陣列最大數量

    ReDim counts(min_value To max_value) '依最大值至最小值的範圍，定義該範圍數量的陣列

    ' Count the values.

    For i = min To max

        counts(list(i)) = counts(list(i)) + 1 '將list陣列值帶入counts陣列，並統計count陣列數量

    Next i

    ' Write the items back into the list array.

    ReDim RepCell(min To max, 1)

    ReDim RepNo(min To max, 1)

    next_index = min

    RepCon = min

    For i = min_value To max_value 'i迴圈表示,歷遍最小值至最大值的範圍數值

        Select Case counts(i) '判斷陣列存在與否

        Case Is = 1 '若等於1,表示陣列存在,且無重複

            For j = 1 To counts(i)

                list(next_index) = i '將數值遞回list陣列

                next_index = next_index + 1

            Next j

        Case Is > 1 '若大於1,表示陣列存在,且重複

            For j = 1 To counts(i)

                list(next_index) = i

                next_index = next_index + 1

            Next j

            RepCell(RepCon, 1) = i '帶入重覆數值

            RepNo(RepCon, 1) = counts(i) '帶入數值重覆次數

            RepCon = RepCon + 1

        End Select

    Next i

    Range(Cells(1, 4), Cells(1, 5)) = Array("重複數值", "重複次數")

    Range(Cells(2, 4), Cells(UBound(RepCell) + 1, 4)) = RepCell '填入重複數值

    Range(Cells(2, 5), Cells(UBound(RepNo) + 1, 5)) = RepNo '填入重複次數

End Sub

Sub Countingsort1(list) '由大到小

    min_value = Minimum(list) '比出最小值

    max_value = Maximum(list) '比出最大值

    min = LBound(list) '陣列最小數量

    max = UBound(list) '陣列最大數量

    ReDim counts(min_value To max_value) '依最大值至最小值的範圍，定義該範圍數量的陣列

    ' Count the values.

    For i = min To max

        counts(list(i)) = counts(list(i)) + 1 '將list陣列值帶入counts陣列，並統計count陣列數量

    Next i

    next_index = min

    For i = max_value To min_value Step -1 'i迴圈表示,歷遍最小值至最大值的範圍數值

        If counts(i) >= 1 Then '判斷陣列存在與否

            For j = 1 To counts(i) 'j迴圈表示,檢查存在的counts陣列數量

                list(next_index) = i '將數值遞回list陣列

                next_index = next_index + 1 'next_index表示陣列index

            Next j

        End If

    Next i

End Sub

Private Function Maximum(l)

    Dim s1, s2

    Dim i

    s1 = LBound(l) '取出陣列最小數量

    s2 = UBound(l) '取出陣列最大數量

    Maximum = l(s1) '定義初值

    For i = s1 To s2 '歷遍全部陣列

        If l(i) > Maximum Then Maximum = l(i) '若l(i)的值比初值(Maximum)大，初值(Maximum)則被l(i)取代

    Next i

End Function

Private Function Minimum(l)

    Dim s1, s2

    Dim i

    s1 = LBound(l)

    s2 = UBound(l)

    Minimum = l(s1)

    For i = s1 To s2

        If l(i) < Minimum Then Minimum = l(i)

    Next i

End Function

 範例下載：陣列-排序法.rar