Hej, Hej hej! Hej igensortera text
har en 2 dimensionell array som jag vill sortera. Första kolumnen innehåller textvärden (datumvärden) medans andra kolumnen innehåller värden. Jag vill sortera på datum.
Nån som har nån bra sorteringsalgoritm?
De exempel man hittar på nätet (ex quicksort) hanterar ju bara numeriska värden korrekt..?
Har även upptäckt en del mindre intelligenta sorteringsrutiner som visserligen sorterar an multidimensionell array, men utan att ta hänsyn till arrayens inbördes förhållanden.
Det vill säga:
'datum
array(0,0) = "1999-02-01"
array(0,1) = "1999-01-01"
'värden
array(1,0) = "1"
array(1,1) = "3.33"
skall bli:
'datum
array(0,0) = "1999-01-01"
array(0,1) = "1999-02-01"
'värden
array(1,0) = "3.33"
array(1,1) = "1"
och inte:
'datum
array(0,0) = "1999-01-01"
array(0,1) = "1999-02-01"
'värden
array(1,0) = "1"
array(1,1) = "3.33"
...i såna fall vill jag ju andra dimensionens sortering skall hänga med i första dimensionens sortering, så inte 1999-01-01 får värdet för 1999-02-01. Självklart förvisso, men jag har hittat exempel som utger sig för att klara av att sortera multudimensionella arrayer, som bara möblerar om utan hänsyn till sk BY-variabler. Man kan fråga sig nyttan med dessa..?
som sagt, tacksam för bra sorteringsalgoritmer för text.
/AxelSv: sortera text
Måste komma med min gamla vals
Datum lagras bäst som Long.
Enligt denna princip
Dim lngDatum As Long
lngDatum = CDate(Date)
Label1.Caption = lngDatum
'Du får tillbaka rätt format med
Label2.Caption = Format$(lngDatum,"yyyy-mm-dd")
Idag är det dag 37488 sedan 1900-01-01
Om du vill ha datum före 1900-01-01
skriver du - (minustecken framför)
Tex 1632-11-06 blir -97573
mvh
SvenSv: sortera text
Förvisso, men i de fall jag vill sortera text funkar det ju inte. Visst - i detta fallet kan man ju lagra datum som longs. Vad jag letar efter är en sorteringsalgoritm som inte har begränsningar, som att den tex måste ha datum i long eller viss annan text i t ex hash-tabeller.
/AxelSv: sortera text
Var tvungen att testa mitt uppskick Programarkivet:Sortera Array QuickSort QuickSort
Ändrade lite i DataTyperne och voila det funkar alldeles utmärkt
med att sortera strängar.
'SvenPon 2000-03-21
'När Ni skall använd algoritmen praktiskt i Era projekt
'så laddar ni dData på lämpligt vis tex For sats.
'Sätt rätt sort på As tex As String om det är text
'Ni som har snabba processorer får trixa till tidmätningen
'med något lämligt API
Option Explicit
DefLng A-Z
Dim dData(100) As String
Private Sub Command1_Click()
Dim i, totElements, T1 As Single, T2 As Single, srtTime As Single
totElements = HScroll1.Value
'slumpar in double:s i dData
For i = 0 To 100
dData(i) = Format$(Int(Rnd * 37000), "yyyy-mm-dd")
Next
Screen.MousePointer = vbHourglass
T1 = Timer
'QSort kör med rekursivt anrop
'när den kommit igång
Call QSort(0, totElements)
T2 = Timer
srtTime = (T2 - T1) / 1000
Label4 = Format(srtTime, "0.00000") & " sek"
Screen.MousePointer = vbDefault
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Dim i As Long
For i = 0 To UBound(dData)
List1.AddItem dData(i)
Next 'i
End Sub
Private Sub Form_Load()
Label1 = "Storlek på Array som skall sorteras " _
& Format$(HScroll1.Value, "####")
End Sub
Private Sub HScroll1_Change()
Label1 = "Storlek på Array som skall sorteras: " _
& Format$(HScroll1.Value, "####")
End Sub
Private Sub QSort(lower As Long, upper As Long)
Dim pivot As String, temp As String
Dim first, last, middle As String
' deklarera mittpunkt i dData "pivot"
first = lower ' lägsta pekare
last = upper ' högsta pekare
middle = (first + last) / 2
pivot = dData(middle)
Do ' kör pekarna mot varandra
While dData(first) < pivot
first = first + 1
Wend
While dData(last) > pivot
last = last - 1
Wend
If first <= last Then
temp = dData(first)
dData(first) = dData(last)
dData(last) = temp
first = first + 1
last = last - 1
End If
Loop Until first > last
If lower < last Then
'Rekursiva anrop
Call QSort(lower, last)
End If
If first < upper Then
Call QSort(first, upper)
End If
End Sub
Sven