30. april 2006 - 23:26Der er
21 kommentarer og 1 løsning
Sortering af array
Function ShellSort(vArray) Dim TempVal Dim i, GapSize, CurPos Dim FirstRow, LastRow, NumRows FirstRow = LBound(vArray) LastRow = UBound(vArray) NumRows = LastRow - FirstRow + 1 Do GapSize = GapSize * 3 + 1 Loop Until GapSize > NumRows Do GapSize = GapSize \ 3 For i = (GapSize + FirstRow) To LastRow CurPos = i TempVal = vArray(i) Do While CompareResult(CDbl(vArray(CurPos - GapSize)),CDbl(TempVal)) vArray(CurPos) = vArray(CurPos - GapSize) CurPos = CurPos - GapSize If (CurPos - GapSize) < FirstRow Then Exit Do Loop vArray(CurPos) = TempVal Next Loop Until GapSize = 1 End Function
Function CompareResult(Value1, Value2) CompareResult = (Value1 > Value2) End Function
Jeg har denne kode til at sorter et array, men den komme med fejlen : Microsoft VBScript runtime (0x800A000D) Type mismatch: 'LBound' /vl10/vaertskaber.asp, line 34
Umiddelbart er problemet af iData ikke er et array. Du kan teste om vArray er et array med funktionen isArray(vArray) inde i shellsort-funktionen inden du går igang med at bruge array-funktioner som lbound og ubound på den. Noget i stil med dette:
Function ShellSort(vArray) Dim TempVal Dim i, GapSize, CurPos Dim FirstRow, LastRow, NumRows if IsArray(vArray) then FirstRow = LBound(vArray) LastRow = UBound(vArray) NumRows = LastRow - FirstRow + 1 Do GapSize = GapSize * 3 + 1 Loop Until GapSize > NumRows Do GapSize = GapSize \ 3 For i = (GapSize + FirstRow) To LastRow CurPos = i TempVal = vArray(i) Do While CompareResult(CDbl(vArray(CurPos - GapSize)),CDbl(TempVal)) vArray(CurPos) = vArray(CurPos - GapSize) CurPos = CurPos - GapSize If (CurPos - GapSize) < FirstRow Then Exit Do Loop vArray(CurPos) = TempVal Next Loop Until GapSize = 1 else ' meddel en fejl hvis vArray ikke er et array - man kunne også bare ignorere fejlen response.write "vArray er ikke et array" end if End Function
Function CompareResult(Value1, Value2) CompareResult = (Value1 > Value2) End Function
' Opbygning af SQL streng strSQL = "SELECT * FROM Vaertskaber Where Aar =" & "'" & iAar & "'" 'Response.Write(strSQL)
'Open DB rs.Open strSQL, strDSN, 1
'Make a loop finding the number of dates 'i = 0 'do while not rs.eof 'Looping rows ' iString = rs("Date") ' Response.Write iString & "<br>" ' If iString <> "" Then ' i = i + 1 ' End If ' rs.MoveNext 'Loop
'Make a loop finding the number of dates i = 0 redim iDate(0) do while not rs.eof 'Looping rows iString = rs("Date") Response.Write iString & "<br>" If iString <> "" Then i = i + 1 redim preserve iDate(i) iDate(i-1)=iString End If rs.MoveNext Loop
ShellSort iData
Max = ubound(iDate) 'Response.Write Max & "<br>"
For i = 0 to Max Response.Write iDate(i) & "<br>" Next
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.