Liste fra Array med sortering

Det er i hvert fald let at lave i en DB i Access - hvis det kan bruges

Hvordan henter du data fra excel?

Skal flymodellen fremgå at listen selvom den er valgt en gang?

henter data fra Excel via Jet.4.0

kovalt....  ???  det skal være en dropdownbox.....  hvor valgmulighederne skal være forskellige typer fly.....  en må kun være der én gang.....

Henter fra hele kolonnen via rs.("f8")  hvilket giver alle flymodeller som de er i regnearket.....  så de kommer flere gange..... 

Derfor et Array...  hvor flymodel smide i.... ved næste record kigges om modellen allerede er i Array'et.... hvis det er.... så skal den bare rs.movenext
og hvis den ikke er der i forvejen så skal den tilføjes og så rs.movenext

Hvorfor er den samme model flere gange i regnearket.... var det ikke muligt at eliminere den redundans

Nej... .dette er ikke muligt.... det er et regneark som et flightlog... så det samme fly flyves med flere gange, men ikke altid af samme person.....

Tjeck http://kenneth.vidur.dk/hmk-eksperten.gif

Det skulle give en idé om hvad jeg laver.....

selve siden findes på http://zone.vidur.dk    men den del jeg arbejder med findes dog ikke på nette, kun lokalt.....

brug http://zone.vidur.dk/tester.asp  for at se hele XLS-filen..

/Lester_dk

Hvorfor laver du "drop-down-menuen" på baggrund af en excel-fil.... kunne du ikke lige så godt lave den manuelt?

både og.....  problemet er dog at nye fly kommer til... og skal derfor automatisk registreres på listen.....

lad os starte med array.....

Skal have lavet et array....? Hvordan gøres det når man ikke på forhånd ved hvor mange entries der kommer.....

Dim myarray
Dim i
i = 0

while not rs.eof
  if myarray(0) = "" then
    myarray(0) = rs("f8")
  else
    i = i + 1
    myarray(i) = myarray(i) & rs("f8")
  end if
rs.movenext
wend

Denne ting skulle fylde flytyperne ind i hver deres nummer......  uden dog at tjekke for dubletter.......  dette eksempel er desværre forkert.... hvad er der galt... ¿  og hvordan er det smartest at tjekke for dubletter og springe den over....?

Tror ikke helt jeg har fattet konceptet i Arrays.... dammit boy...

Her er en mulighed... Den lister Arrayet efter dato... -det kan du selvfølgelig selv variere om du vil have, du kan bare sortere efter hvad du finder om Date() Funktionen...


' QSort2
'
' This version sorts a 2-dimensional array on the iIdx column
' Performance on a P233MMX with 64M of RAM:
' ~55 seconds to sort 100,000 rows of random integers.
'
' Parameters:
'
' aData    array to be sorted
' iIdx  index of column to use for sorting
' iLb  lower-bound of elements to be sorted
' iUb  upper-bound of elements to be sorted
'
' e.g. QSort2(aData, 0, 0, ubound(aData)) ' sort the entire array based on column 0
'      QSort2(aData, 3, 3, 8) ' sort elements from index 3 to 8 based on column 3

Public Sub QSort2(aData, iIdx, iLb, iUb)
Dim lbStack(32)
Dim ubStack(32)
Dim sp              ' stack pointer
Dim iLbx            ' current lower-bound
Dim iUbx            ' current upper-bound
Dim m
Dim p              ' index to pivot
Dim i
Dim j
Dim t              ' temp used for exchanges

lbStack(0) = iLb
ubStack(0) = iUb
sp = 0
Do While sp >= 0
  iLbx = lbStack(sp)
  iUbx = ubStack(sp)

  Do While (iLbx < iUbx)

  ' select pivot and exchange with 1st element
  p = iLbx + (iUbx - iLbx) \ 2

  ' exchange iLbx, p
  Swap aData, iLbx, p

  ' partition into two segments
  i = iLbx + 1
  j = iUbx
  Do
    Do While i < j
    If aData(iLbx, iIdx) <= aData(i, iIdx) Then Exit Do
    i = i + 1
    Loop

    Do While j >= i
    If aData(j, iIdx) <= aData(iLbx, iIdx) Then Exit Do
    j = j - 1
    Loop

    If i >= j Then Exit Do

    ' exchange i, j
    Swap aData, i, j

    j = j - 1
    i = i + 1
  Loop

  ' pivot belongs in aData[j]
  ' exchange iLbx, j
  Swap aData, iLbx, j
 
  m = j

  ' keep processing smallest segment, and stack largest
  If m - iLbx <= iUbx - m Then
    If m + 1 < iUbx Then
    lbStack(sp) = m + 1
    ubStack(sp) = iUbx
    sp = sp + 1
    End If
    iUbx = m - 1
  Else
    If m - 1 > iLbx Then
    lbStack(sp) = iLbx
    ubStack(sp) = m - 1
    sp = sp + 1
    End If
    iLbx = m + 1
  End If
  Loop
  sp = sp - 1
Loop
End Sub

' ======================================================================
'
' Swap()
'
' Used by QSort2, this sub swaps two rows in a 2 dimensional array
'
' Parameters:
'
' aData    array to work with
' iRow1    index of first row
' iRow2    index of second row
'
' e.g. Swap(A, 3, 8) ' swap the 4th and 9th rows in A.

Public Sub Swap(aData, iRow1, iRow2)
Dim i, tmp

' Get values into Tmp
For i = 0 to Ubound(aData, 2)
  tmp = aData(iRow1, i)
  aData(iRow1, i) = aData(iRow2, i)
  aData(iRow2, i) = tmp
Next
End Sub

' ======================================================================
'
' Transpose()
'
' Changes the data in a two dimensional array from:
' (x,y) => (y,x).  This can be useful if you don't
' like the way RECORDSET.getrows() works.  Calling
' Transpose() is a quick way to get your array into
' the proper form for QSort2().
'
' Parameters:
'
' aData    array to be transposed
'
' Returns:
'
' New transposed array.
'
' Performance on a P233MMX with 64M of RAM:
' ~5 seconds to transpose 100,000 rows.
'
' e.g. a2 = Transpose(a1)

Public Function Transpose(aData)
Dim i, j, aTmp

' Dimension Tmp the opposite of A
Redim aTmp(ubound(aData, 2), ubound(aData))

' Transpose
For i = 0 to ubound(aData, 2)
  For j = 0 to ubound(aData)
  aTmp(i, j) = aData(j, i)
  Next
Next

Transpose = aTmp
End Function

//>Rune

For mig at se, så er rækkefølgen ikke vigtig..... nærmere om den samme værdi er der flere gange... 

arbejder på en idé om at den for hver iteration vælger at smide det ind i array'et hvis den ikke er der i forvejen.....

Eller mulighed 2: smide alt sammen ind i array'et og så bagfra tjekke om array(ubound(array)) er = array(0) to array(ubound(array)-1) eller noget lignenede... men ved ikke hvordan dette gøres.....

mit forsøg ser således ud pt.

Det virker for mig som om det er mine tællere n & i der ikke bruges korrekt af mig.

<%
adUseServer = 2
adOpenDynamic = 2
adLockOptimistic = 3
adCmdText = 1
Dim rs, SQLtemp, StrConnect, flyv_art
Set rs = Server.CreateObject("ADODB.Recordset")
'Don't use client-side cursors - no updates will be allowed
rs.CursorLocation = adUseServer
rs.Open "SELECT * FROM [Flyvedata$]", xlCn, adOpenDynamic, adLockOptimistic, adCmdText

dim n, statement
Dim Array()
i = 0
n = 0

While Not rs.EOF AND VarType(rs(1))>1
Redim Preserve Array(i)
statement=false
For n = 0 to ubound(Array)
    If rs("f8") = Array(n) Then
    statement=true 'match fundet
'response.end ' bruges ikke.. skulle gerne stoppe løkken hvis match fundet.. ingen grund til at fortsætte der.
   
Else statement=false 'match IKKE fundet
Array(i) = rs("f8")' så derfor tilføj modeltype i array
End if
n = n + 1
next
i = i + 1
rs.MoveNext
Wend

dim counter
counter = 0

For counter = 0 to ubound(array)   
    response.write "<option>" & array(counter) & "</option>"
next
Set rs = Nothing
%>

Man blive lidt skitzo af at snakke med sig selv.... men I skal da bare råbe i munden på hinanden.. eller er der endenlig en problemstilling der IKKE kan løses.... !!!!

Det kan virke som et dumt spørgsmål fordi jeg måske ikke helt har forstået problemet, men hvis du henter flymodellerne v.h.a. "SELECT * FROM [Flyvedata$]" - kunne du ikke "bare" bruge "SELECT DISTINCT f8 FROM [Flyvedata$]" istedet?

det kunne man godt ja... men problemet er at der er naturlig redundans i denne kolonne (Excel)  Og det udtræk jeg laver skal kun rumme hver flytype én gang......  Det skal nemlig bruges i en valgliste......  med <option>flytype</option>

Erstat med

Response.Write "<tr><td valign=top><div class='header1'><font size=1><b><a href='links.asp?mode=id&id='" & rs("ID") & ""

Det er et helvede med " og '

ups... forkert spg....

Jamen, det er jo netop det DISTINCT gør, nemlig returnerer kun en post for hver type. Eller også fatter jeg ikke en sk..

..af dit problem :-)

aha......  det må jeg prøve så....  takker foreløbigt.....

Det virker... og er da 1.000.000 gange nemmere....  dog tager den også et tomt felt med.... hvilket giver en tom linie i min liste.......  men kan ikke fjerne det.... 

Henter som sagt fra et excel-dokument.... og bruger dermed

                    AND VarType(rs(1))>1
           
til at undgå tomme felter... men nu har jeg brugt distinct...  så min rs(1) skal hedde noget andet......  men hvad....

<%
adUseServer = 2
adOpenDynamic = 2
adLockOptimistic = 3
adCmdText = 1
Dim rs
Set rs = Server.CreateObject("ADODB.Recordset")
'Don't use client-side cursors - no updates will be allowed
rs.CursorLocation = adUseServer
rs.Open "SELECT DISTINCT f8 FROM [Flyvedata$]", xlCn, adOpenDynamic, adLockOptimistic, adCmdText

While NOT rs.EOF AND VarType(rs(1))>1
    response.write "<option>" & rs("f8") & "</option>"
rs.movenext
Wend

Set rs = Nothing
%>

Det er jo bare at spørge om det er tomt!

<%
adUseServer = 2
adOpenDynamic = 2
adLockOptimistic = 3
adCmdText = 1
Dim rs
Set rs = Server.CreateObject("ADODB.Recordset")
'Don't use client-side cursors - no updates will be allowed
rs.CursorLocation = adUseServer
rs.Open "SELECT DISTINCT f8 FROM [Flyvedata$]", xlCn, adOpenDynamic, adLockOptimistic, adCmdText

While NOT rs.EOF AND VarType(rs(1))>1
  If Not rs("f8") = "" Then
    response.write "<option>" & rs("f8") & "</option>"
  End If
rs.movenext
Wend

Set rs = Nothing
%>

//>Rune

Thx 4 Poinz

//>Rune

sblar  du skal også have points.......  opretter en til dig... svar og du skal få....  http://www.eksperten.dk/spm/245543  du får 200 points.....