25. april 2003 - 14:26Der er
9 kommentarer og 1 løsning
Array fjern dubletter
Jeg har en favoritliste (profilsystem), hvor favoritter bliver listet på en side. Favoritter er gemt i db i feltet favorite_users som et array af ID'er- ( ex. 1,4,6) På visningssiden er der checkboxe med value=<%userid%> så er det meningen at man skal kunne afkrydse de favoritter som man ønsker at fjerne fra listen. jeg sender data til updatefavorites.asp og har her 2 arrays
Hele favoritlisten: mailuserid= request.cookies("username")("userid") Set rs = Server.CreateObject("ADODB.RecordSet") strSQL = "SELECT users.favorite_users FROM users WHERE users.userid=" & mailuserid RS.CursorLocation = adUseClient rs.Open strSQL, conn, 1, 1 If Not rs.EOF Then Favorit_Users=rs("Favorit_Users")&"" arr1=Favorit_Users end if 'her udskrives arr1 response.write arr1 &"<br>" %> De favoritter der skal fjernes <% for each item in request.form if request.form(item)<>"" then arr2=request.form(item) end if next 'her udskrives arr2 response.write arr2 %> Hvordan får jeg så et tredie array arr3 som er lig med arr1 - arr2 - altså hvor dubletter er fjernet
Du kan lave en function lige som denne som kan fjerne et element fra et array ud fra den værdi som er i arrayet:
Sub RemoveFromArray(aList, RemoveThis) Dim I for i = LBound(aList) to UBound(aList) if Cstr(aList(i)) = Cstr(RemoveThis) then RemoveThisIndex = i exit for end if next if RemoveThisIndex = "" then exit Sub If RemoveThisIndex > UBound(aList) Then Exit Sub End If If RemoveThisIndex < UBound(aList) Then ' Shuffle the elements down For I = RemoveThisIndex + 1 to UBound(aList) aList(I - 1) = aList(I) Next End If ReDim Preserve aList(Ubound(aList) - 1) End Sub
Så kan du lave din koden sådan her som så giver dif arr3 med som i princippet er arr1-arr2
arr1arr = Split(arr1, ",")
arr2arr = Split(arr2, ",")
for i = lbound(arr2arr) to ubound(arr2arr) RemoveFromArray arr1arr,arr2arr(i) next for i = lbound(arr1arr) to ubound(arr1arr) arr3 = arr3 & "," & arr1arr(i) next if arr3 <> "" then arr3 = Mid(arr3,2) 'Fjerner føste komma
Her er en anden måde, hvor der ikke 'shuffles' så meget:
' Split de 2 strenge og opnå 'rigtige' arrays a1 = Split(arr1, ",") a2 = Split(arr2, ",")
' Start med tomt arr3 arr3 = ""
for inx1 = 0 to UBound(a1) dublet = false for inx2 = 0 to UBound(a2) if a1(inx1) = a2(inx2) then dublet = true end if next if not dublet then arr3 = arr3 & a1(inx1) if inx1 < UBound(a1) then arr3 = arr3 & "," end if end if next
Man kan endag lave det med string functioner så kan koden laves sådan her, så løber man kun genne det array som skal fjernes, det forudsætter dog at der i arr1 ikke er mellemrum mellem , og tal eks "1,23,4,6" virker mend "1, 23, 4, 6" virker ikke.
'Lav arr2 til et array arr2arr = Split(arr2, ",") 'Sæt komma ind før og efter i arr1 så der er noget at søge efter. arr1 = "," & arr1 & "," for i = lbound(arr2arr) to ubound(arr2arr) index = InStr(1, arr1, "," & arr2arr(i) & ",") if index > 0 then arr1 = Left(arr1,index) & Mid(arr1,inStr(index+1, arr1, ",")+1) end if next arr3 = Mid(arr1,2,len(arr1)-2)
Ups - Når jeg prøver at slette den sidste på listen: Set rs1 = Server.CreateObject("ADODB.RecordSet") strSQL = "UPDATE users SET users.Blocked_Users='" & arr3 & "' WHERE userid=" & mailuserid RS1.CursorLocation = adUseClient rs1.Open strSQL, conn, 1, 1 response.redirect "favorites.asp" Får jeg flg: Microsoft VBScript runtime error '800a0005' Invalid procedure call or argument: 'Mid' hvad så...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
