MultiArraySort Function:
Sorts multidimensional arrays by column either ascending or descending.
Description:
The function will sort a multidimensional array and reorder all the information in each row of the array so that the selected column of the array is sorted. The first row of the array is used to decide what variable types are being used for the sort column.
Syntax:
SortArray = MultiArraySort(unsortedarray, sortcolumn, sortdirection)
Details:
sortdirection argument: either a (ascending) d (descending)
The result of the example below will be:
ford blue 12.500,00
toyota white 22.000,00
bmw yellow 26.000,00
porsche red 50.000,00
Example:
<%
'--- create a multidimensional array
Dim myArray(2,3)
'--- myArray(col, row)
myArray(0, 0) = "toyota"
myArray(1, 0) = "white"
myArray(2, 0) = "22.000,00"
myArray(0, 1) = "ford"
myArray(1, 1) = "blue"
myArray(2, 1) = "12.500,00"
myArray(0, 2) = "porsche"
myArray(1, 2) = "red"
myArray(2, 2) = "50.000,00"
myArray(0, 3) = "bmw"
myArray(1, 3) = "yellow"
myArray(2, 3) = "26.000,00"
Dim i
Dim MultiArraySorted
Dim intSortColumn
Dim strSortDirection
intSortColumn = 2 '--- sort by column 2
strSortDirection = "desc" '--- sort direction either "asc" or "desc"
If isArray(MyArray) Then
MultiArraySorted = MultiArraySort(MyArray, intSortColumn, strSortDirection)
End if
'--- sort array and display the result
Response.Write "<table border='0'>"
Response.Write "<tr><td>Col</td><td>0</td>"
Response.Write "<td>1</td><td>2</td></tr>"
Response.Write "<tr><td>Row</td><td>Car</td>"
Response.Write "<td>Color</td><td>Cost</td></tr>"
For i = 0 to UBound(MultiArraySorted, 2)
Response.Write "<tr><td>" & i & "</td>"
Response.Write "<td>" & MultiArraySorted(0,i) & "</td>"
Response.Write "<td>" & MultiArraySorted(1,i) & "</td>"
Response.Write "<td>" & MultiArraySorted(2,i) & "</td></tr>"
Next
Response.Write "</table>"
%>
ASP Source Code:
<%
Private Function MultiArraySort(ByVal values(), ByVal intSortCol, ByVal sSort_Dir)
Dim i
Dim j
Dim value
Dim value_j
dim min
dim max
dim temp
dim datatype
dim intComp
dim intA
dim intCheckIndex
Dim strDirection
strDirection = Left(sSort_Dir, 1)
On Error Resume next
min = lbound(values,2)
max = ubound(values,2)
'--- check to see what direction you want to sort.
'--- "d" = descending
if lcase(strDirection) = "d" then
intComp = -1
else
intComp = 1
end if
if intSortCol < 0 or intSortCol > ubound(values,1) then
arraysort = values
exit function
end if
'--- find the first item which has valid data in it to sort
intCheckIndex = min
while len(trim(values(intSortCol,intCheckIndex))) = 0 and intCheckIndex < ubound(values,2)
intCheckIndex = intCheckIndex + 1
wend
if isDate(trim(values(intSortCol,intCheckIndex))) then
datatype = 1
else
if isNumeric(trim(values(intSortCol,intCheckIndex))) then
datatype = 2
else
datatype = 0
end if
end if
For i = min To max - 1
value = values(intSortCol,i)
value_j = i
For j = i + 1 To max
select case datatype
case 0
'--- See if values(j) is smaller. works with strings now.
If strComp(values(intSortCol,j),value,vbTextCompare) = intComp Then
'--- Save the new smallest value.
value = values(intSortCol,j)
value_j = j
End If
case 1
if intComp = -1 then
if DateDiff("s",values(intSortCol,j),value) > 0 then
'--- Save the new smallest value.
value = values(intSortCol,j)
value_j = j
end if
else
if DateDiff("s",values(intSortCol,j),value) < 0 then
'--- Save the new smallest value.
value = values(intSortCol,j)
value_j = j
end if
end if
case 2
if intComp = -1 then
if cdbl(values(intSortCol,j)) < cdbl(value) then
'--- Save the new smallest value.
value = values(intSortCol,j)
value_j = j
end if
else
if cdbl(values(intSortCol,j)) > cdbl(value) then
'--- Save the new smallest value.
value = values(intSortCol,j)
value_j = j
end if
end if
end select
Next 'j
If value_j <> i Then
'--- Swap items i and value_j.
for intA = 0 to ubound(values,1)
temp = values(intA,value_j)
values(intA,value_j) = values(intA,i)
values(intA,i) = temp
next '--- intA
End If
Next '--- i
If Err Then
On Error GoTo 0
Err.Raise 5156, "MultiArraySort Function", _
"An error occurred sorting multiple array."
End If
MultiArraySort = values
End Function
%>
|
