¿Cómo puedo ordenar las matrices usando vbscript?

La pregunta lo dice todo realmente, pero …

Estoy escaneando un archivo en busca de líneas que coincidan con un cierto patrón de expresiones regulares, y luego quiero imprimir las líneas que coinciden, pero en orden alfabético. Estoy seguro de que esto es trivial, pero vbscript no es mi background

mi arreglo se define como

Dim lines(10000) 

si eso hace alguna diferencia, y estoy tratando de ejecutar mi script desde un prompt cmd normal

Gracias

Desde Microsoft

Ordenando matrices en VBScript nunca ha sido fácil; eso es porque VBScript no tiene ningún tipo de comando de ordenación. A su vez, eso siempre significaba que los scripters de VBScript se vieron obligados a escribir sus propias rutinas de ordenación, ya sea una rutina de ordenación de burbujas, una ordenación de montones, una vía rápida o algún otro tipo de algoritmo de clasificación.

Entonces (usando .Net como está instalado en mi pc):

 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 

Sé que este es un tema bastante antiguo, pero podría ser útil para cualquier persona en el futuro. el script a continuación hace lo que el tío estaba tratando de lograr usando vbscript. cuando los términos ordenados comenzando en mayúsculas tendrán prioridad.

 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 

Los conjuntos de registros desconectados pueden ser útiles.

 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 

Aquí hay una QuickSort que escribí para las matrices devueltas del método GetRows de ADODB.Recordset.

 '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 

Si va a dar salida a las líneas de todos modos, puede ejecutar la salida a través del comando de ordenación. No es elegante, pero no requiere mucho trabajo:

 cscript.exe //nologo YOUR-SCRIPT | Sort 

Nota // nologo omite las líneas del logotipo ( Microsoft (R) Windows Script Host Version … blah blah blah) para que no aparezcan en el medio de la salida ordenada. (Supongo que MS no sabe para qué es stderr).

Consulte http://ss64.com/nt/sort.html para obtener detalles sobre la ordenación.

/ + n es la opción más útil si su clave de clasificación no comienza en la primera columna.

Las comparaciones son siempre insensibles a mayúsculas y minúsculas , lo cual es poco convincente.

Aquí hay otra implementación de vbscript de quicksort. Este es el enfoque in situ e inestable como se define en wikipedia (ver aquí: http://en.wikipedia.org/wiki/Quicksort ). Utiliza mucha menos memoria (la implementación original requiere que se creen matrices de almacenamiento temporal superior e inferior en cada iteración, lo que puede boost el tamaño de la memoria en términos n en el peor de los casos).

Para orden ascendente, cambie los signos.

Si desea ordenar caracteres, use la funció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 

O bien debes escribir tu propio tipo a mano, o tal vez probar esta técnica:

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

Puede mezclar libremente JavaScript del lado del servidor con VBScript, de modo que donde sea que VBScript se quede corto, cambie a javascript.

VBScript no tiene un método para ordenar matrices, por lo que tiene dos opciones:

  • Escribir una función de clasificación como mergesort, desde cero.
  • Use la sugerencia de JScript de este artículo

Esta es una implementación de vbscript de tipo de combinación.

 '@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 

Al tener matrices grandes (“anchas”), en lugar de mover cada elemento de una larga fila de datos, utilice una matriz unidimensional con índices de la matriz.

inicialice ptr_arr con 0,1,2,3, .. uBound (arr) luego acceda a los datos con

 arr(field_index,ptr_arr(row_index)) 

en lugar de

 arr(field_index,row_index) 

y simplemente intercambie los elementos de ptr_arr en lugar de intercambiar las filas.

Si está procesando la matriz fila por fila, por ejemplo, mostrándola como a, puede dejar de lado el bucle interno:

 max_col=uBound(arr,1) response.write "" for n = 0 to uBound(arr,2) response.write "" row=ptr_arr(n) for i=0 to max_col response.write "" next response.write " next response.write "
"&arr(i,row)&"
"

Un poco de selección de matriz de la vieja escuela. Por supuesto, esto solo ordena matrices de una dimensión.

‘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 

De hecho, tuve que hacer algo similar pero ayer con una matriz 2D. No estoy tan al tanto de vbscript y este proceso realmente me empantanó. Descubrí que los artículos aquí estaban muy bien escritos y me ayudaron a ordenar vbscript.