Public Function AddToArray(ByRef arDaten As Variant, ByVal Index As Long, _
    ParamArray values() As Variant)
Dim I As Long
 
For I = 0 To UBound(values)
    arDaten(Index, I) = values(I)
Next I
End Function
 
Public Function Zeile_Auslesen(ByVal Code As String) As String
Dim sLines() As String
Dim TMP() As String
Dim newHTML, newHTML1, newHTML2 As String
Dim I, X, Y As Integer
Dim edit As Byte
Dim Min, Max As Integer
Dim Zeit, Zeit1 As String
Dim ID As String
Dim geb(99, 5) As String
 
edit = 0
sLines = Split(Code, vbCrLf)
 
On Error GoTo zeile
For I = 0 To UBound(sLines)
    Select Case edit
    Case 0
        If sLines(I) = "<TD vAlign=top width=" & Chr(34) & "10%" & Chr(34) & "" & _
          "align=right><B>Status</B></TD></TR>" Then
            edit = 1
            Min = I + 1
            newHTML = newHTML & sLines(I) & vbCrLf
        Else
            If sLines(I) = "<STYLE type=text/css>" Then
            sLines(I + 11) = "      color:black;  background-color:transparent;"
            sLines(I + 12) = "      "
            End If
            newHTML = newHTML & sLines(I) & vbCrLf
        End If
    Case 1
        If sLines(I) = "<SCRIPT language=javascript>" Then
            edit = 2
            Max = I - 1
            newHTML1 = newHTML1 & sLines(I) & vbCrLf
        End If
    Case 2
        newHTML1 = newHTML1 & sLines(I) & vbCrLf
    End Select
Next I
Y = 0
 
On Error GoTo ort
 
sLines(Max) = Mid(sLines(Max), 1, Len(sLines(Max)) - 87)
 
For X = Min To Max Step 5
    TMP = Split(sLines(X + 4), ">")   
    Zeit = sLines(X + 4) 
    Select Case GebSort
    Case 1 'größe
        AddToArray geb, Y, sLines(X), sLines(X + 1), sLines(X + 2), sLines(X + _
          3), Zeit, _
            100 - Format(Val(Mid(sLines(X), 8)), "00") & Format(Val(Mid(sLines( _
            X + 2), InStrRev(sLines _
            (X + 2), " ", Len(sLines(X + 2)) - 9))), "00000") & Format(Left(Mid( _
            sLines(X + 2), InStr(sLines(X + 2), _
            "A:") + 2), InStr(1, Mid(sLines(X + 2), InStr(sLines(X + 2), "A:") _
            + 2), " ")), "0000")
    Case 2 'zeit
        AddToArray geb, Y, sLines(X), sLines(X + 1), sLines(X + 2), sLines(X + _
          3), Zeit, _
            100 - Format(Val(Mid(sLines(X), 8)), "00") & 9999999 - Format(Val( _
            Replace(TMP(2), ":", "")) _
            , "0000000")
    End Select
    Y = Y + 1
Next X
On Error GoTo sort
QuickSortMultiDim geb, 6
On Error GoTo zu
For Y = 0 To 99
 
    If geb(Y, 0) = "" Then
        newHTML = newHTML & _
          "</TR></TBODY></TABLE></TD></TR></T" & _
          "ODY></TABLE></DIV></DIV><!-- Spielfeld STATS Ende-->" & vbCrLf
    Else
        If geb(Y, 0) = ID Then
        newHTML = newHTML & geb(Y, 0) & vbCrLf & geb(Y, 1) & vbCrLf & geb(Y, 2) _
          & vbCrLf & geb(Y, 3) & vbCrLf & geb(Y, 4) & vbCrLf
        Else
        ID = geb(Y, 0)
        newHTML = newHTML & "<tr><td class=white2><B>" & Mid(geb(Y, _
          2), 41, InStr(41, geb(Y, 2), " ", vbTextCompare) - 41) & _
          "</B></td>" & vbCrLf & geb(Y, 0) & vbCrLf & geb(Y, 1) & vbCrLf _
          & geb(Y, 2) & vbCrLf & geb(Y, 3) & vbCrLf & geb(Y, 4) & vbCrLf
        End If
    End If
Next Y
newHTML2 = newHTML + newHTML1
Zeile_Auslesen = newHTML2
newHTML = ""
newHTML1 = ""
newHTML1 = ""
Erase geb
Erase sLines
Erase TMP
Exit Function
 
zeile:
    MsgBox "fehler beim zerlegen der Daten!" & vbCrLf & "fehlercode: " & vbCrLf _
      & Err.Number & vbCrLf & Err.Description
    Exit Function
ort:
    MsgBox "fehler beim vorsortieren der Daten!" & vbCrLf & "fehlercode: " & _
      vbCrLf & Err.Number & vbCrLf & Err.Description
Exit Function
sort:
    MsgBox "fehler beim sortieren der Daten!" & vbCrLf & "fehlercode: " & _
      vbCrLf & Err.Number & vbCrLf & Err.Description
Exit Function
zu:
    MsgBox "fehler beim zusammensetzen der Daten!" & vbCrLf & "fehlercode: " & _
      vbCrLf & Err.Number & vbCrLf & Err.Description
    Exit Function
End Function