vbscriptを使用して配列を並べ替えるにはどうすればよいですか？

Question

質問は本当にそれをすべて言っていますが、...

特定の正規表現パターンに一致する行を探してファイルをスキャンし、一致するがアルファベット順に行を印刷したい。これは簡単なことですが、vbscriptは私の背景ではありません。

私の配列は

Dim lines(10000)

それが違いを生む場合、私は通常のcmdプロンプトからスクリプトを実行しようとしています

ありがとう

Answer 1

から Microsoft

VBScriptで配列を並べ替えるのは簡単ではありませんでした。これは、VBScriptには並べ替えコマンドがないためです。また、VBScriptスクリプト作成者は、バブルソートルーチン、ヒープソート、クイックソート、またはその他の種類のソートアルゴリズムなど、独自のソートルーチンの作成を強制されていました。

だから（私のPCにインストールされている.Netを使用して）：

Set outputLines = CreateObject("System.Collections.ArrayList")

'add lines
outputLines.Add output
outputLines.Add output

outputLines.Sort()
For Each outputLine in outputLines
    stdout.WriteLine outputLine
Next

Answer 2

これはかなり古いトピックですが、将来誰にとっても役に立つかもしれません。以下のスクリプトは、vbscriptを使用して純粋に達成しようとしていたことを実行します。大文字で始まる用語を並べ替えると優先されます。

for a = UBound(ArrayOfTerms) - 1 To 0 Step -1
    for j= 0 to a
        if ArrayOfTerms(j)>ArrayOfTerms(j+1) then
            temp=ArrayOfTerms(j+1)
            ArrayOfTerms(j+1)=ArrayOfTerms(j)
            ArrayOfTerms(j)=temp
        end if
    next
next 

Answer 3

切断されたレコードセットは便利です。

Const adVarChar = 200  'the SQL datatype is varchar

'Create a disconnected recordset
Set rs = CreateObject("ADODB.RECORDSET")
rs.Fields.append "SortField", adVarChar, 25

rs.CursorType = adOpenStatic
rs.Open
rs.AddNew "SortField", "Some data"
rs.Update
rs.AddNew "SortField", "All data"
rs.Update

rs.Sort = "SortField"

rs.MoveFirst

Do Until rs.EOF
    strList=strList & vbCrLf & rs.Fields("SortField")        
    rs.MoveNext
Loop 

MsgBox strList

Answer 4

ADODB.RecordsetのGetRowsメソッドから返される配列用に作成したQuickSortを次に示します。

'Author:        Eric Weilnau
'Date Written:  7/16/2003
'Description:   QuickSortDataArray sorts a data array using the QuickSort algorithm.
'               Its arguments are the data array to be sorted, the low and high
'               bound of the data array, the integer index of the column by which the
'               data array should be sorted, and the string "asc" or "desc" for the
'               sort order.
'
Sub QuickSortDataArray(dataArray, loBound, hiBound, sortField, sortOrder)
    Dim pivot(), loSwap, hiSwap, count
    ReDim pivot(UBound(dataArray))

    If hiBound - loBound = 1 Then
        If (sortOrder = "asc" and dataArray(sortField,loBound) > dataArray(sortField,hiBound)) or (sortOrder = "desc" and dataArray(sortField,loBound) < dataArray(sortField,hiBound)) Then
            Call SwapDataRows(dataArray, hiBound, loBound)
        End If
    End If

    For count = 0 to UBound(dataArray)
        pivot(count) = dataArray(count,int((loBound + hiBound) / 2))
        dataArray(count,int((loBound + hiBound) / 2)) = dataArray(count,loBound)
        dataArray(count,loBound) = pivot(count)
    Next

    loSwap = loBound + 1
    hiSwap = hiBound

    Do
        Do While (sortOrder = "asc" and dataArray(sortField,loSwap) <= pivot(sortField)) or sortOrder = "desc" and (dataArray(sortField,loSwap) >= pivot(sortField))
            loSwap = loSwap + 1

            If loSwap > hiSwap Then
                Exit Do
            End If
        Loop

        Do While (sortOrder = "asc" and dataArray(sortField,hiSwap) > pivot(sortField)) or (sortOrder = "desc" and dataArray(sortField,hiSwap) < pivot(sortField))
            hiSwap = hiSwap - 1
        Loop

        If loSwap < hiSwap Then
            Call SwapDataRows(dataArray,loSwap,hiSwap)
        End If
    Loop While loSwap < hiSwap

    For count = 0 to Ubound(dataArray)
        dataArray(count,loBound) = dataArray(count,hiSwap)
        dataArray(count,hiSwap) = pivot(count)
    Next

    If loBound < (hiSwap - 1) Then
        Call QuickSortDataArray(dataArray, loBound, hiSwap-1, sortField, sortOrder)
    End If

    If (hiSwap + 1) < hiBound Then
        Call QuickSortDataArray(dataArray, hiSwap+1, hiBound, sortField, sortOrder)
    End If
End Sub

Answer 5

とにかく行を出力する場合は、sortコマンドを使用して出力を実行できます。エレガントではありませんが、多くの作業は必要ありません。

cscript.exe //nologo YOUR-SCRIPT | Sort

注// nologoは、ロゴ行を省略します（Microsoft（R）Windows Script Host Version...何とか何とか）ソートされた出力の中央に表示されないようにします。 （私はMSがstderrの目的を知らないと思います。）

ソートの詳細については、 http://ss64.com/nt/sort.html を参照してください。

/ + nは、ソートキーが最初の列で始まらない場合に最も便利なオプションです。

比較は常にcase-insensitiveであり、ラメです。

Answer 6

クイックソートの別のvbscript実装を次に示します。これは、ウィキペディアで定義されているインプレースの不安定なアプローチです（こちらを参照してください： http://en.wikipedia.org/wiki/Quicksort ）。使用するメモリがはるかに少なくなります（元の実装では、反復ごとに上位および下位の一時ストレージ配列を作成する必要があり、最悪の場合はメモリサイズをn項増やすことができます）。

昇順の場合は、記号を切り替えます。

文字を並べ替えるには、Asc（ch）関数を使用します。

'-------------------------------------
 '  quicksort
 '    Carlos Nunez, created: 25 April, 2010.
 '
 '  NOTE:   partition function also
 '          required
 '-------------------------------------
function qsort(list, first, last)
    Dim i, j
    if (typeName(list) <> "Variant()" or ubound(list) = 0) then exit function       'list passed must be a collection or array.

    'if the set size is less than 3, we can do a simple comparison sort.
    if (last-first) < 3 then
        for i = first to last
            for j = first to last
                if list(i) < list(j) then
                    swap list,i,j
                end if
            next
        next
    else
        dim p_idx

        'we need to set the pivot relative to the position of the subset currently being sorted.
        'if the starting position of the subset is the first element of the whole set, then the pivot is the median of the subset.
        'otherwise, the median is offset by the first position of the subset.
        '-------------------------------------------------------------------------------------------------------------------------
        if first-1 < 0 then
            p_idx   = round((last-first)/2,0)
        else
            p_idx   = round(((first-1)+((last-first)/2)),0)
        end if

        dim p_nidx:     p_nidx  = partition(list, first, last, p_idx)
        if p_nidx = -1 then exit function

        qsort list, first, p_nidx-1
        qsort list, p_nidx+1, last
    end if
end function


function partition(list, first, last, idx)
    Dim i
    partition = -1

    dim p_val:      p_val = list(idx)
    swap list,idx,last
    dim swap_pos:   swap_pos = first
    for i = first to last-1 
        if list(i) <= p_val then
            swap list,i,swap_pos
            swap_pos = swap_pos + 1
        end if
    next
    swap list,swap_pos,last

    partition = swap_pos
end function

function swap(list,a_pos,b_pos)
    dim tmp
    tmp = list(a_pos)
    list(a_pos) = list(b_pos)
    list(b_pos) = tmp   
end function

Answer 7

これは、マージソートのvbscript実装です。

'@Function Name: Sort
'@Author: Lewis Gordon
'@Creation Date: 4/26/12
'@Description: Sorts a given array either in ascending or descending order, as specified by the
'                order parameter.  This array is then returned at the end of the function.
'@Prerequisites:  An array must be allocated and have all its values inputted.
'@Parameters:
'    $ArrayToSort:  This is the array that is being sorted.
'    $Order:  This is the sorting order that the array will be sorted in.  This parameter 
'                can either    be "ASC" or "DESC" or ascending and descending, respectively.
'@Notes:  This uses merge sort under the hood.  Also, this function has only been tested for
'            integers and strings in the array.  However, this should work for any data type that
'            implements the greater than and less than comparators.  This function also requires
'            that the merge function is also present, as it is needed to complete the sort.
'@Examples:
'    Dim i
'    Dim TestArray(50)
'    Randomize
'    For i=0 to UBound(TestArray)
'        TestArray(i) = Int((100 - 0 + 1) * Rnd + 0)
'    Next
'    MsgBox Join(Sort(TestArray, "DESC"))
'
'@Return value:  This function returns a sorted array in the specified order.
'@Change History: None

'The merge function.
Public Function Merge(LeftArray, RightArray, Order)
    'Declared variables
    Dim FinalArray
    Dim FinalArraySize
    Dim i
    Dim LArrayPosition
    Dim RArrayPosition

    'Variable initialization
    LArrayPosition = 0
    RArrayPosition = 0

    'Calculate the expected size of the array based on the two smaller arrays.
    FinalArraySize = UBound(LeftArray) + UBound(RightArray) + 1
    ReDim FinalArray(FinalArraySize)

    'This should go until we need to exit the function.
    While True

        'If we are done with all the values in the left array.  Add the rest of the right array
        'to the final array.
        If LArrayPosition >= UBound(LeftArray)+1 Then
            For i=RArrayPosition To UBound(RightArray)
                FinalArray(LArrayPosition+i) = RightArray(i)
            Next
            Merge = FinalArray
            Exit Function

        'If we are done with all the values in the right array.  Add the rest of the left array
        'to the final array.
        ElseIf RArrayPosition >= UBound(RightArray)+1 Then
            For i=LArrayPosition To UBound(LeftArray)
                FinalArray(i+RArrayPosition) = LeftArray(i)
            Next
            Merge = FinalArray
            Exit Function

        'For descending, if the current value of the left array is greater than the right array 
        'then add it to the final array.  The position of the left array will then be incremented
        'by one.
        ElseIf LeftArray(LArrayPosition) > RightArray(RArrayPosition) And UCase(Order) = "DESC" Then
            FinalArray(LArrayPosition+RArrayPosition) = LeftArray(LArrayPosition)
            LArrayPosition = LArrayPosition + 1

        'For ascending, if the current value of the left array is less than the right array 
        'then add it to the final array.  The position of the left array will then be incremented
        'by one.
        ElseIf LeftArray(LArrayPosition) < RightArray(RArrayPosition) And UCase(Order) = "ASC" Then
            FinalArray(LArrayPosition+RArrayPosition) = LeftArray(LArrayPosition)
            LArrayPosition = LArrayPosition + 1

        'For anything else that wasn't covered, add the current value of the right array to the
        'final array.
        Else
            FinalArray(LArrayPosition+RArrayPosition) = RightArray(RArrayPosition)
            RArrayPosition = RArrayPosition + 1
        End If
    Wend
End Function

'The main sort function.
Public Function Sort(ArrayToSort, Order)
    'Variable declaration.
    Dim i
    Dim LeftArray
    Dim Modifier
    Dim RightArray

    'Check to make sure the order parameter is okay.
    If Not UCase(Order)="ASC" And Not UCase(Order)="DESC" Then
        Exit Function
    End If
    'If the array is a singleton or 0 then it is sorted.
    If UBound(ArrayToSort) <= 0 Then
        Sort = ArrayToSort
        Exit Function
    End If

    'Setting up the modifier to help us split the array effectively since the round
    'functions aren't helpful in VBScript.
    If UBound(ArrayToSort) Mod 2 = 0 Then
        Modifier = 1
    Else
        Modifier = 0
    End If

    'Setup the arrays to about half the size of the main array.
    ReDim LeftArray(Fix(UBound(ArrayToSort)/2))
    ReDim RightArray(Fix(UBound(ArrayToSort)/2)-Modifier)

    'Add the first half of the values to one array.
    For i=0 To UBound(LeftArray)
        LeftArray(i) = ArrayToSort(i)
    Next

    'Add the other half of the values to the other array.
    For i=0 To UBound(RightArray)
        RightArray(i) = ArrayToSort(i+Fix(UBound(ArrayToSort)/2)+1)
    Next

    'Merge the sorted arrays.
    Sort = Merge(Sort(LeftArray, Order), Sort(RightArray, Order), Order)
End Function

Answer 8

大きな（「幅の広い」）配列を使用する場合、長いデータ行の各要素を移動する代わりに、配列のインデックスを持つ1次元配列を使用します。

ptr_arrを0,1,2,3、.. uBound（arr）で初期化してから、データにアクセスします

arr(field_index,ptr_arr(row_index))

の代わりに

arr(field_index,row_index)

行を交換する代わりに、ptr_arrの要素を交換するだけです。

配列を行ごとに処理している場合、たとえば、として表示している場合、内部ループからルックアウトを取り出すことができます。

max_col=uBound(arr,1)
response.write "<table>"
for n = 0 to uBound(arr,2)
  response.write "<tr>"
  row=ptr_arr(n)
  for i=0 to max_col
    response.write "<td>"&arr(i,row)&"</td>"
  next
  response.write "</tr>
next
response.write "</table>" 

Answer 9

独自のソートを手動で記述するか、この手法を試す必要があります。

http://www.aspfaqs.com/aspfaqs/ShowFAQ.asp?FAQID=8

サーバー側のJavaScriptとVBScriptを自由に混在させることができるため、VBScriptが足りない場合はいつでもJavaScriptに切り替えてください。

Answer 10

VBScriptには配列を並べ替える方法がないため、次の2つのオプションがあります。

• Mergesortのようなソート関数をゼロから作成します。
• この記事 のJScriptヒントを使用してください

Answer 11

古い学校の配列の並べ替え。もちろん、これは単一次元配列のみをソートします。

'C：\ DropBox\Automation\Libraries\Array.vbs

Option Explicit

Public Function Array_AdvancedBubbleSort(ByRef rarr_ArrayToSort(), ByVal rstr_SortOrder)
'   ==================================================================================
'   Date            : 12/09/1999
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Creates a sorted Array from a one dimensional array
'                       in Ascending (default) or Descending order based on the rstr_SortOrder.
'   Variables       :
'                   rarr_ArrayToSort()     The array to sort and return.
'                   rstr_SortOrder   The order to sort in, default ascending or D for descending.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_AdvancedBubbleSort"
    Dim bln_Sorted
    Dim lng_Loop_01
    Dim str_SortOrder
    Dim str_Temp

    bln_Sorted = False
    str_SortOrder = Left(UCase(rstr_SortOrder), 1) 'We only need to know if the sort order is A(SENC) or D(ESEND)...and for that matter we really only need to know if it's D because we are defaulting to Ascending.
    Do While (bln_Sorted = False)
       bln_Sorted = True
        str_Temp = ""
        If (str_SortOrder = "D") Then
            'Sort in descending order.
            For lng_Loop_01 = LBound(rarr_ArrayToSort) To (UBound(rarr_ArrayToSort) - 1)
                If (rarr_ArrayToSort(lng_Loop_01) < rarr_ArrayToSort(lng_Loop_01 + 1)) Then
                    bln_Sorted = False
                    str_Temp = rarr_ArrayToSort(lng_Loop_01)
                    rarr_ArrayToSort(lng_Loop_01) = rarr_ArrayToSort(lng_Loop_01 + 1)
                    rarr_ArrayToSort(lng_Loop_01 + 1) = str_Temp
                End If
                If (rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - (lng_Loop_01 - 1)) > rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - lng_Loop_01)) Then
                    bln_Sorted = False
                    str_Temp = rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - (lng_Loop_01 - 1))
                    rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - (lng_Loop_01 - 1)) = rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - lng_Loop_01)
                    rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - lng_Loop_01) = str_Temp
                End If
            Next
        Else
            'Default to Ascending.
            For lng_Loop_01 = LBound(rarr_ArrayToSort) To (UBound(rarr_ArrayToSort) - 1)
                If (rarr_ArrayToSort(lng_Loop_01) > rarr_ArrayToSort(lng_Loop_01 + 1)) Then
                    bln_Sorted = False
                    str_Temp = rarr_ArrayToSort(lng_Loop_01)
                    rarr_ArrayToSort(lng_Loop_01) = rarr_ArrayToSort(lng_Loop_01 + 1)
                    rarr_ArrayToSort(lng_Loop_01 + 1) = str_Temp
                End If
                If (rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - (lng_Loop_01 - 1)) < rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - lng_Loop_01)) Then
                    bln_Sorted = False
                    str_Temp = rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - (lng_Loop_01 - 1))
                    rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - (lng_Loop_01 - 1)) = rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - lng_Loop_01)
                    rarr_ArrayToSort((UBound(rarr_ArrayToSort) - 1) - lng_Loop_01) = str_Temp
                End If
            Next
        End If
    Loop
End Function

Public Function Array_BubbleSort(ByRef rarr_ArrayToSort())
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_BubbleSort"
    Dim lng_Loop_01
    Dim lng_Loop_02
    Dim var_Temp

    For lng_Loop_01 = (UBound(rarr_ArrayToSort) - 1) To 0 Step -1
        For lng_Loop_02 = 0 To lng_Loop_01
            If rarr_ArrayToSort(lng_Loop_02) > rarr_ArrayToSort(lng_Loop_02 + 1) Then
                var_Temp = rarr_ArrayToSort(lng_Loop_02 + 1)
                rarr_ArrayToSort(lng_Loop_02 + 1) = rarr_ArrayToSort(lng_Loop_02)
                rarr_ArrayToSort(lng_Loop_02) = var_Temp
            End If
        Next
    Next
End Function

Public Function Array_GetDimensions(ByVal rarr_Array)
    Const const_FUNCTION_NAME = "Array_GetDimensions"
    Dim int_Dimensions
    Dim int_Result
    Dim str_Dimensions

    int_Result = 0
    If IsArray(rarr_Array) Then
        On Error Resume Next
        Do
            int_Dimensions = -2
            int_Dimensions = UBound(rarr_Array, int_Result + 1)
            If int_Dimensions > -2 Then
                int_Result = int_Result + 1
                If int_Result = 1 Then
                    str_Dimensions = str_Dimensions & int_Dimensions
                Else
                    str_Dimensions = str_Dimensions & ":" & int_Dimensions
                End If
            End If
        Loop Until int_Dimensions = -2
        On Error GoTo 0
    End If
    Array_GetDimensions = int_Result ' & ";" & str_Dimensions
End Function

Public Function Array_GetUniqueCombinations(ByVal rarr_Fields, ByRef robj_Combinations)
    Const const_FUNCTION_NAME = "Array_GetUniqueCombinations"
    Dim int_Element
    Dim str_Combination

    On Error Resume Next

    Array_GetUniqueCombinations = CBool(False)
    For int_Element = LBound(rarr_Fields) To UBound(rarr_Fields)
        str_Combination = rarr_Fields(int_Element)
        Call robj_Combinations.Add(robj_Combinations.Count & ":" & str_Combination, 0)
'        Call Array_GetUniqueCombinationsSub(rarr_Fields, robj_Combinations, int_Element)
    Next 'int_Element
    For int_Element = LBound(rarr_Fields) To UBound(rarr_Fields)
        Call Array_GetUniqueCombinationsSub(rarr_Fields, robj_Combinations, int_Element)
    Next 'int_Element
    Array_GetUniqueCombinations = CBool(True)
End Function 'Array_GetUniqueCombinations

Public Function Array_GetUniqueCombinationsSub(ByVal rarr_Fields, ByRef robj_Combinations, ByRef rint_LBound)
    Const const_FUNCTION_NAME = "Array_GetUniqueCombinationsSub"
    Dim int_Element
    Dim str_Combination

    On Error Resume Next

    Array_GetUniqueCombinationsSub = CBool(False)
    str_Combination = rarr_Fields(rint_LBound)
    For int_Element = (rint_LBound + 1) To UBound(rarr_Fields)
        str_Combination = str_Combination & "," & rarr_Fields(int_Element)
        Call robj_Combinations.Add(robj_Combinations.Count & ":" & str_Combination, str_Combination)
    Next 'int_Element
    Array_GetUniqueCombinationsSub = CBool(True)
End Function 'Array_GetUniqueCombinationsSub

Public Function Array_HeapSort(ByRef rarr_ArrayToSort())
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_HeapSort"
    Dim lng_Loop_01
    Dim var_Temp
    Dim arr_Size

    arr_Size = UBound(rarr_ArrayToSort) + 1
    For lng_Loop_01 = ((arr_Size / 2) - 1) To 0 Step -1
        Call Array_SiftDown(rarr_ArrayToSort, lng_Loop_01, arr_Size)
    Next
    For lng_Loop_01 = (arr_Size - 1) To 1 Step -1
        var_Temp = rarr_ArrayToSort(0)
        rarr_ArrayToSort(0) = rarr_ArrayToSort(lng_Loop_01)
        rarr_ArrayToSort(lng_Loop_01) = var_Temp
        Call Array_SiftDown(rarr_ArrayToSort, 0, (lng_Loop_01 - 1))
    Next
End Function

Public Function Array_InsertionSort(ByRef rarr_ArrayToSort())
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_InsertionSort"
    Dim lng_ElementCount
    Dim lng_Loop_01
    Dim lng_Loop_02
    Dim lng_Index

    lng_ElementCount = UBound(rarr_ArrayToSort) + 1
    For lng_Loop_01 = 1 To (lng_ElementCount - 1)
        lng_Index = rarr_ArrayToSort(lng_Loop_01)
        lng_Loop_02 = lng_Loop_01
        Do While lng_Loop_02 > 0
            If rarr_ArrayToSort(lng_Loop_02 - 1) > lng_Index Then
                rarr_ArrayToSort(lng_Loop_02) = rarr_ArrayToSort(lng_Loop_02 - 1)
                lng_Loop_02 = (lng_Loop_02 - 1)
            End If
        Loop
        rarr_ArrayToSort(lng_Loop_02) = lng_Index
    Next
End Function

Private Function Array_Merge(ByRef rarr_ArrayToSort(), ByRef rarr_ArrayTemp(), ByVal rlng_Left, ByVal rlng_MiddleIndex, ByVal rlng_Right)
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Merges an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_Merge"
    Dim lng_Loop_01
    Dim lng_LeftEnd
    Dim lng_ElementCount
    Dim lng_TempPos

    lng_LeftEnd = (rlng_MiddleIndex - 1)
    lng_TempPos = rlng_Left
    lng_ElementCount = (rlng_Right - rlng_Left + 1)
    Do While (rlng_Left <= lng_LeftEnd) _
    And (rlng_MiddleIndex <= rlng_Right)
        If rarr_ArrayToSort(rlng_Left) <= rarr_ArrayToSort(rlng_MiddleIndex) Then
            rarr_ArrayTemp(lng_TempPos) = rarr_ArrayToSort(rlng_Left)
            lng_TempPos = (lng_TempPos + 1)
            rlng_Left = (rlng_Left + 1)
        Else
            rarr_ArrayTemp(lng_TempPos) = rarr_ArrayToSort(rlng_MiddleIndex)
            lng_TempPos = (lng_TempPos + 1)
            rlng_MiddleIndex = (rlng_MiddleIndex + 1)
        End If
    Loop
    Do While rlng_Left <= lng_LeftEnd
        rarr_ArrayTemp(lng_TempPos) = rarr_ArrayToSort(rlng_Left)
        rlng_Left = (rlng_Left + 1)
        lng_TempPos = (lng_TempPos + 1)
    Loop
    Do While rlng_MiddleIndex <= rlng_Right
        rarr_ArrayTemp(lng_TempPos) = rarr_ArrayToSort(rlng_MiddleIndex)
        rlng_MiddleIndex = (rlng_MiddleIndex + 1)
        lng_TempPos = (lng_TempPos + 1)
    Loop
    For lng_Loop_01 = 0 To (lng_ElementCount - 1)
        rarr_ArrayToSort(rlng_Right) = rarr_ArrayTemp(rlng_Right)
        rlng_Right = (rlng_Right - 1)
    Next
End Function

Public Function Array_MergeSort(ByRef rarr_ArrayToSort(), ByRef rarr_ArrayTemp(), ByVal rlng_FirstIndex, ByVal rlng_LastIndex)
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   Note            :The rarr_ArrayTemp array that is passed in has to be dimensionalized to the same size
'                           as the rarr_ArrayToSort array that is passed in prior to calling the function.
'                           Also the rlng_FirstIndex variable should be the value of the LBound(rarr_ArrayToSort)
'                           and the rlng_LastIndex variable should be the value of the UBound(rarr_ArrayToSort)
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_MergeSort"
    Dim lng_MiddleIndex

    If rlng_LastIndex > rlng_FirstIndex Then
        ' Recursively sort the two halves of the list.
        lng_MiddleIndex = ((rlng_FirstIndex + rlng_LastIndex) / 2)
        Call Array_MergeSort(rarr_ArrayToSort, rarr_ArrayTemp, rlng_FirstIndex, lng_MiddleIndex)
        Call Array_MergeSort(rarr_ArrayToSort, rarr_ArrayTemp, lng_MiddleIndex + 1, rlng_LastIndex)
        '  Merge the results.
        Call Array_Merge(rarr_ArrayToSort, rarr_ArrayTemp, rlng_FirstIndex, lng_MiddleIndex + 1, rlng_LastIndex)
    End If
End Function

Public Function Array_Push(ByRef rarr_Array, ByVal rstr_Value, ByVal rstr_Delimiter)
    Const const_FUNCTION_NAME = "Array_Push"
    Dim int_Loop
    Dim str_Array_01
    Dim str_Array_02

    'If there is no delimiter passed in then set the default delimiter equal to a comma.
    If rstr_Delimiter = "" Then
        rstr_Delimiter = ","
    End If

    'Check to see if the rarr_Array is actually an Array.
    If IsArray(rarr_Array) = True Then
        'Verify that the rarr_Array variable is only a one dimensional array.
        If Array_GetDimensions(rarr_Array) <> 1 Then
            Array_Push = "ERR, the rarr_Array variable passed in was not a one dimensional array."
            Exit Function
        End If
        If IsArray(rstr_Value) = True Then
            'Verify that the rstr_Value variable is is only a one dimensional array.
            If Array_GetDimensions(rstr_Value) <> 1 Then
                Array_Push = "ERR, the rstr_Value variable passed in was not a one dimensional array."
                Exit Function
            End If
            str_Array_01 = Split(rarr_Array, rstr_Delimiter)
            str_Array_02 = Split(rstr_Value, rstr_Delimiter)
            rarr_Array = Join(str_Array_01 & rstr_Delimiter & str_Array_02)
        Else
            On Error Resume Next
            ReDim Preserve rarr_Array(UBound(rarr_Array) + 1)
            If Err.Number <> 0 Then ' "Subscript out of range"  An array that was passed in must have been Erased to re-create it with new elements (possibly when passing an array to be populated into a recursive function)
                ReDim rarr_Array(0)
                Err.Clear
            End If
            If IsObject(rstr_Value) = True Then
                Set rarr_Array(UBound(rarr_Array)) = rstr_Value
            Else
                rarr_Array(UBound(rarr_Array)) = rstr_Value
            End If
        End If
    Else
        'Check to see if the rstr_Value is an Array.
        If IsArray(rstr_Value) = True Then
            'Verify that the rstr_Value variable is is only a one dimensional array.
            If Array_GetDimensions(rstr_Value) <> 1 Then
                Array_Push = "ERR, the rstr_Value variable passed in was not a one dimensional array."
                Exit Function
            End If
            rarr_Array = rstr_Value
        Else
            rarr_Array = Split(rstr_Value, rstr_Delimiter)
        End If
    End If
    Array_Push = UBound(rarr_Array)
End Function

Public Function Array_QuickSort(ByRef rarr_ArrayToSort(), ByVal rlng_Low, ByVal rlng_High)
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   Note            :The rlng_Low variable should be the value of the LBound(rarr_ArrayToSort)
'                           and the rlng_High variable should be the value of the UBound(rarr_ArrayToSort)
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_QuickSort"
    Dim var_Pivot
    Dim lng_Swap
    Dim lng_Low
    Dim lng_High

    lng_Low = rlng_Low
    lng_High = rlng_High
    var_Pivot = rarr_ArrayToSort((rlng_Low + rlng_High) / 2)
    Do While lng_Low <= lng_High
        Do While (rarr_ArrayToSort(lng_Low) < var_Pivot _
        And lng_Low < rlng_High)
            lng_Low = lng_Low + 1
        Loop
        Do While (var_Pivot < rarr_ArrayToSort(lng_High) _
        And lng_High > rlng_Low)
            lng_High = (lng_High - 1)
        Loop
        If lng_Low <= lng_High Then
            lng_Swap = rarr_ArrayToSort(lng_Low)
            rarr_ArrayToSort(lng_Low) = rarr_ArrayToSort(lng_High)
            rarr_ArrayToSort(lng_High) = lng_Swap
            lng_Low = (lng_Low + 1)
            lng_High = (lng_High - 1)
        End If
    Loop
    If rlng_Low < lng_High Then
        Call Array_QuickSort(rarr_ArrayToSort, rlng_Low, lng_High)
    End If
    If lng_Low < rlng_High Then
        Call Array_QuickSort(rarr_ArrayToSort, lng_Low, rlng_High)
    End If
End Function

Public Function Array_SelectionSort(ByRef rarr_ArrayToSort())
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_SelectionSort"
    Dim lng_ElementCount
    Dim lng_Loop_01
    Dim lng_Loop_02
    Dim lng_Min
    Dim var_Temp

    lng_ElementCount = UBound(rarr_ArrayToSort) + 1
    For lng_Loop_01 = 0 To (lng_ElementCount - 2)
        lng_Min = lng_Loop_01
        For lng_Loop_02 = (lng_Loop_01 + 1) To lng_ElementCount - 1
            If rarr_ArrayToSort(lng_Loop_02) < rarr_ArrayToSort(lng_Min) Then
            lng_Min = lng_Loop_02
            End If
        Next
        var_Temp = rarr_ArrayToSort(lng_Loop_01)
        rarr_ArrayToSort(lng_Loop_01) = rarr_ArrayToSort(lng_Min)
        rarr_ArrayToSort(lng_Min) = var_Temp
    Next
End Function

Public Function Array_ShellSort(ByRef rarr_ArrayToSort())
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sorts an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_ShellSort"
    Dim lng_Loop_01
    Dim var_Temp
    Dim lng_Hold
    Dim lng_HValue

    lng_HValue = LBound(rarr_ArrayToSort)
    Do
        lng_HValue = (3 * lng_HValue + 1)
    Loop Until lng_HValue > UBound(rarr_ArrayToSort)
    Do
        lng_HValue = (lng_HValue / 3)
        For lng_Loop_01 = (lng_HValue + LBound(rarr_ArrayToSort)) To UBound(rarr_ArrayToSort)
            var_Temp = rarr_ArrayToSort(lng_Loop_01)
            lng_Hold = lng_Loop_01
            Do While rarr_ArrayToSort(lng_Hold - lng_HValue) > var_Temp
                rarr_ArrayToSort(lng_Hold) = rarr_ArrayToSort(lng_Hold - lng_HValue)
                lng_Hold = (lng_Hold - lng_HValue)
                If lng_Hold < lng_HValue Then
                    Exit Do
                End If
            Loop
            rarr_ArrayToSort(lng_Hold) = var_Temp
        Next
    Loop Until lng_HValue = LBound(rarr_ArrayToSort)
End Function

Private Function Array_SiftDown(ByRef rarr_ArrayToSort(), ByVal rlng_Root, ByVal rlng_Bottom)
'   ==================================================================================
'   Date            : 03/18/2008
'   Author          : Christopher J. Scharer (CJS)
'   Description     : Sifts the elements down in an array.
'   ==================================================================================
    Const const_FUNCTION_NAME = "Array_SiftDown"
    Dim bln_Done
    Dim max_Child
    Dim var_Temp

    bln_Done = False
    Do While ((rlng_Root * 2) <= rlng_Bottom) _
    And bln_Done = False
        If rlng_Root * 2 = rlng_Bottom Then
            max_Child = (rlng_Root * 2)
        ElseIf rarr_ArrayToSort(rlng_Root * 2) > rarr_ArrayToSort(rlng_Root * 2 + 1) Then
            max_Child = (rlng_Root * 2)
        Else
            max_Child = (rlng_Root * 2 + 1)
        End If
        If rarr_ArrayToSort(rlng_Root) < rarr_ArrayToSort(max_Child) Then
            var_Temp = rarr_ArrayToSort(rlng_Root)
            rarr_ArrayToSort(rlng_Root) = rarr_ArrayToSort(max_Child)
            rarr_ArrayToSort(max_Child) = var_Temp
            rlng_Root = max_Child
        Else
            bln_Done = True
        End If
    Loop
End Function