World Of Webmaster
Đăng nhập / Đăng ký
Account
Free for web
Check pagerank
Input check pager (Not http://)

Ext: blog.kai.vn
Check google pagerank
View HTML source
FUNCTION LIBRARY
HTML Tags Library
PHP Functions Library ASP Functions Library
ASP Functions MultiArraySort
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
  %> 

StrToArray
SplitRegExp
SelectionSort
RevArray
RemDups
RandomArray
HasDups
ExchangeSort
ArrayAverage
CombSort
Library ›› HTML Tag | PHP Function | ASP Function
Page : 806906
Online :
Visited : 370229
 
Liên h | Thêm vào Favorite | Gửi link qua e-mail | Thông tin website
Copright © 2009 KAI Blog
Code by BOINGOnline. Contact email : contact@kai.vn
Theme: default | classic |