Chức năng: Sắp xếp mảng đa chiều trong cột theo thứ tự xác định
Ngôn ngữ: asp - Nhóm: array
CÚ PHÁP
SortArray = MultiArraySort(unsortedarray, sortcolumn, sortdirection)
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
VÍ DỤ
<%
'--- 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 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
%>