我正在扫描一个文件以查找与某个正则表达式模式匹配的行，然后我想打印出匹配但按字母顺序排列的行。我确定这是微不足道的，但 vbscript 不是我的背景
我的数组定义为
Dim lines(10000)
如果这有什么不同，我正在尝试从正常的 cmd 提示符执行我的脚本
Oskar
问问题
121721 次
13 回答
45
来自微软
在 VBScript 中对数组进行排序从未如此简单。那是因为 VBScript 没有任何类型的排序命令。反过来，这总是意味着 VBScript 脚本编写者被迫编写自己的排序例程，无论是冒泡排序例程、堆排序、快速排序还是某种其他类型的排序算法。
所以（使用.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
于 2008-11-06T13:21:22.070 回答
23
我知道这是一个相当古老的话题，但它可能对将来的任何人都派上用场。下面的脚本完成了这个家伙试图纯粹使用 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
于 2011-03-06T07:18:32.573 回答
11
断开连接的记录集可能很有用。
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
于 2008-11-21T13:22:54.100 回答
3
这是我为从 ADODB.Recordset 的 GetRows 方法返回的数组编写的快速排序。
'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
于 2008-11-06T14:04:38.427 回答
3
如果您要输出这些行，您可以通过 sort 命令运行输出。不优雅，但不需要太多工作：
cscript.exe //nologo YOUR-SCRIPT | Sort
注意//nologo省略了出现在排序输出中间的徽标行（Microsoft (R) Windows Script Host Version ... blah blah blah）。（我猜 MS 不知道 stderr 是干什么用的。）
有关排序的详细信息，请参见http://ss64.com/nt/sort.html。
如果您的排序键不是从第一列开始，/+n是最有用的选项。
比较总是不区分大小写，这是蹩脚的。
于 2014-07-22T21:33:33.127 回答
2
一些老式的数组排序。当然，这只对一维数组进行排序。
'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
于 2014-12-12T05:08:45.577 回答
1
这是快速排序的另一个 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
于 2011-04-25T15:27:51.117 回答
1
这是合并排序的 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
于 2012-04-27T12:59:02.433 回答
0
您要么必须手动编写自己的排序，要么尝试这种技术：
http://www.aspfaqs.com/aspfaqs/ShowFAQ.asp?FAQID=83
您可以自由地将服务器端 javascript 与 VBScript 混合使用，因此只要 VBScript 不足，就切换到 javascript。
于 2008-11-06T13:21:36.530 回答
0
VBScript 没有对数组进行排序的方法，因此您有两种选择：
- 从头开始编写像mergesort这样的排序函数。
- 使用本文中的 JScript 技巧
于 2008-11-06T13:24:45.620 回答
0
当有大（“宽”）数组时，不要移动一长行数据的每个元素，而是使用带有数组索引的一维数组。
用 0,1,2,3,..uBound(arr) 初始化 ptr_arr 然后用
arr(field_index,ptr_arr(row_index))
代替
arr(field_index,row_index)
并且只是交换 ptr_arr 的元素而不是交换行。
如果您正在逐行处理数组，例如将其显示为 a ，则可以从内部循环中查看：
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>"
于 2013-06-28T07:41:16.813 回答
0
一个古老但仍然被问到的问题。人们发布了指向该解决方案的链接，但现在已损坏，因此我发布了一个示例： 您可以使用 ScriptControl 访问 JScript 的数组排序 您可以提供自己的 jscript 排序功能。不幸的是，它仅适用于 32 位版本的 wsh...
a=split("this is a javascript array sort demo"," ")
wscript.echo vbcrlf & "alphabeticaly"&vbcrlf
a=sort(a)
for each i in a
wscript.echo i
next
wscript.echo vbcrlf & "by length"&vbcrlf
a=sortbylength(a)
for each i in a
wscript.echo i
next
function sort(a)
with createobject("ScriptControl")
.Language = "JScript"
.AddCode "function sortvbs(a) {return a.toArray().sort().join('\b')}"
sort= split(.Run("sortvbs",a),chr(8))
End With
end function
function sortbylength(a)
with createobject("ScriptControl")
.Language = "JScript"
.AddCode "function lensort(a,b){return((('' + a).length > ('' + b).length) ? 1 : ((('' + a).length < ('' + b).length) ? -1 : 0))}"
.Addcode "function sortvbs(a) {return a.toArray().sort(lensort).join('\b')}"
sortbylength= split(.Run("sortvbs",a),chr(8))
End With
end function
于 2021-11-29T09:16:31.493 回答
-2
实际上，我昨天只需要做一些类似的事情，但使用的是 2D 数组。我对 vbscript 的速度并没有那么快，这个过程真的让我陷入了困境。我发现这里的文章写得很好，让我走上了用 vbscript 排序的道路。
于 2008-11-06T13:55:18.897 回答