<%@ Language=VBScript %>
<%
Option Explicit
Response.Expires = 0
On Error Resume Next 

'*****************************************************************
'Variablendeklarationen
Dim arrvar(3,4)
Dim intsortcolumn


'*****************************************************************
'Variableninitialisierung
arrvar(0,0) = 3
arrvar(1,0) = 2
arrvar(2,0) = 1

arrvar(0,1) = "A"
arrvar(1,1) = "D"
arrvar(2,1) = "C"

arrvar(0,2) = DateValue("1.7.61")
arrvar(1,2) = DateValue("20.6.59")
arrvar(2,2) = DateValue("1.1.98")

arrvar(0,3) = "**"
arrvar(1,3) = "***"
arrvar(2,3) = "*"

'*****************************************************************
'Lokale Prozeduren und Funktionen

'Parameter dieser Prozedur
' - arrvar: ein zweidimensionaler Array, wobei erste Dimension
'     den Datensätzen und zweite Dimension den Spalten entspricht
' - intl: Hilfsvariable für linke Position
' - intr: Hilfsvariable für rechte Position
' - intsortcolumn: Spalte, nach der sortiert wird (beginnt bei 0!)
Sub procarrquicksort (ByRef arrvar, ByVal intl, ByVal intr, ByVal intsortcolumn)
  Dim inti, intj, intpivot, intinnercounter ', vartemp
  Dim arrhelp
  
  ReDim arrhelp(UBound(arrvar,2)) 'für jede Spalte 1 Zelle
  
  inti = intl
  intj = intr
  
  intpivot = arrvar((intl + intr)\2, intsortcolumn) 

  Do
    Do While arrvar(inti, intsortcolumn) < intpivot
      inti = inti + 1
    Loop
    Do While intpivot < arrvar(intj, intsortcolumn)
      intj = intj - 1
    Loop
    
    If inti <= intj Then
      'Response.Write("inti: " & inti & " intj: " & intj & "<br />" & vbCrLf)
      For intinnercounter = 0 to UBound(arrhelp)
        arrhelp(intinnercounter) = arrvar(intj, intinnercounter)
        arrvar(intj,intinnercounter) = arrvar(inti,intinnercounter)
        arrvar(inti,intinnercounter) = arrhelp(intinnercounter)
      Next
      inti = inti + 1
      intj = intj - 1
    End If
  Loop While inti <= intj  
  
  If intl <= intj Then 
    call procarrquicksort (arrvar, intl, intj, intsortcolumn)
  End If
  If inti <= intr Then 
    call procarrquicksort (arrvar, inti, intr, intsortcolumn)
  End If
End Sub

Sub procshowarrayastable(ByVal arrvar)
  Dim intcounter
  Dim intinnercounter

  Response.Write("<table border=""1"">" & vbCrLf)
  For intcounter = 0 to UBound(arrvar,1) - 1
    Response.Write("  <tr>" & vbCrLf)
    For intinnercounter = 0 to UBound(arrvar,2) - 1
      Response.Write("    <td>" & arrvar(intcounter,intinnercounter) & "</td>" & vbCrLf)
    Next    
    Response.Write("  </tr>" & vbCrLf)
  Next
  Response.Write("</table>" & vbCrLf)
End Sub

'*****************************************************************
'Anfang Code


'*****************************************************************
'Anfang <html>
%>

<!--#include virtual="asppages/silvi/_include/preheader.inc" -->
<html>
  <head>
    <title>ASP nützliche Routinen: Zweidimensionalen Array sortieren mit Quicksort</title>
    <meta name="description" content="" />
    <meta name="keywords" content="" />
<!--#include virtual="asppages/silvi/_include/header.inc" -->
  </head>
<body>
<%
'*****************************************************************
'Code innerhalb der HTML-Seite
Response.Write("<p><b>Zweidimensionalen Array sortieren mit Quicksort</b></p>")
Response.Write("<i>Vor Sortierung:</i><br />")
call procshowarrayastable(arrvar)

intsortcolumn = 0 'beginnt bei 0
call procarrquicksort(arrvar, 0, UBound(arrvar,1) - 1, intsortcolumn)
Response.Write("&nbsp;<br /><i>Sortiert nach Spalte " & intsortcolumn + 1 & ":</i><br />")
call procshowarrayastable(arrvar)

intsortcolumn = 2
call procarrquicksort(arrvar, 0, UBound(arrvar,1) - 1, intsortcolumn)
Response.Write("&nbsp;<br /><i>Sortiert nach Spalte " & intsortcolumn + 1 & ":</i><br />")
call procshowarrayastable(arrvar)
%>


<!--#include virtual="asppages/silvi/_include/inchtmlnachspann.asp" -->
</body>
</html>

Demo: beispiele/070quicksorttwodimensionalarray.asp

Letzter Update: 26.12.2021 16:48

Zurück zur Liste mit ASP-Beispielen auf  www.ecotronics.ch