Gruppe
Allgemein
Problem
Wie kann ich Fußballergebnisse eines Spieltages in eine Tabelle eintragen, die Tabelle aktualisieren und nach HTML konvertieren?
StandardModule: basTable
Sub Tabelle()
Dim rngA As Range, rngB As Range, rngC As Range
Dim rngD As Range, rngE As Range
Dim iCounter As Integer, iRowL As Integer
iRowL = Cells(Rows.Count, 13).End(xlUp).Row
Set rngC = Range(Cells(1, 13), Cells(iRowL, 17))
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
Set rngD = Range(Cells(4, 2), Cells(iRowL, 2))
Set rngE = Range(Cells(4, 1), Cells(iRowL, 11))
Worksheets("Backup").Range("A1:K15").Value = Range("A1:K15").Value
For iCounter = 1 To rngC.Rows.Count
Set rngA = rngD.Find(rngC.Cells(iCounter, 1))
rngA.Offset(0, 1) = rngA.Offset(0, 1) + 1
Set rngB = rngD.Find(rngC.Cells(iCounter, 2))
rngB.Offset(0, 1) = rngB.Offset(0, 1) + 1
If rngC.Cells(iCounter, 3) > rngC.Cells(iCounter, 5) Then
rngA.Offset(0, 2) = rngA.Offset(0, 2) + 1
rngB.Offset(0, 4) = rngB.Offset(0, 4) + 1
rngA.Offset(0, 9) = rngA.Offset(0, 9) + 3
ElseIf rngC.Cells(iCounter, 3) < rngC.Cells(iCounter, 4) Then
rngB.Offset(0, 2) = rngB.Offset(0, 2) + 1
rngA.Offset(0, 4) = rngA.Offset(0, 4) + 1
rngB.Offset(0, 9) = rngB.Offset(0, 9) + 3
Else
rngA.Offset(0, 3) = rngA.Offset(0, 3) + 1
rngB.Offset(0, 3) = rngB.Offset(0, 3) + 1
rngA.Offset(0, 9) = rngA.Offset(0, 9) + 1
rngB.Offset(0, 9) = rngB.Offset(0, 9) + 1
End If
rngA.Offset(0, 5) = rngA.Offset(0, 5) + rngC.Cells(iCounter, 3)
rngA.Offset(0, 7) = rngA.Offset(0, 7) + rngC.Cells(iCounter, 5)
rngB.Offset(0, 5) = rngB.Offset(0, 5) + rngC.Cells(iCounter, 5)
rngB.Offset(0, 7) = rngB.Offset(0, 7) + rngC.Cells(iCounter, 3)
Next iCounter
rngE.Sort _
Key1:=Range("K1"), Order1:=xlDescending, _
Key2:=Range("F1"), Order2:=xlDescending, _
Key3:=Range("D1"), Order3:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For iCounter = 4 To 15
Cells(iCounter, 1) = iCounter - 3
Cells(iCounter, 10) = Cells(iCounter, 7) - Cells(iCounter, 9)
Next iCounter
End Sub
Sub Zurueck()
Worksheets("Tabelle").Range("A1:K15").Value = _
Worksheets("Backup").Range("A1:K15").Value
End Sub
StandardModule: basHTML
Sub Brig2HTML()
Dim iRow As Integer, iCol As Integer
Dim sFile As String, sTitle As String
sFile = Application.DefaultFilePath & "\brig.htm"
sTitle = "Tabelle Saison " & Year(Date) & "/" & Year(Date) + 1
Close
Open sFile For Output As #1
Print #1, "<html>"
Print #1, "<head>"
Print #1, "<title>" & sTitle & "</title>"
Print #1, "<style type=text/css>"
Print #1, "td { font-size: 8pt; font-family: tahoma,verdana,sans-serif }"
Print #1, "th { font-size: 8pt; font-family: tahoma,verdana,sans-serif }"
Print #1, "</style>"
Print #1, "</head>"
Print #1, "<body bgcolor=#00e0ff><font face=""tahoma,verdana"" size=2>"
Print #1, "<center>"
Print #1, "<table border=2 cellpadding=3 cellspacing=3 bgcolor=#ffffe0>"
Print #1, " <tr bgcolor=#00ffe0><th colspan=9 align=center><font size=4>"
Print #1, " " & sTitle
Print #1, " </font></th></tr>"
Print #1, " <tr bgcolor=#00ffe0>"
Print #1, " <th>Pl.</th><th>Verein</th><th>Spiele</th><th>g</th><th>u</th>"
Print #1, " <th>v</th><th>Tore</th><th>Diff</th><th>Punkte</th>"
Print #1, " </tr>"
iRow = 4
Do Until IsEmpty(Cells(iRow, 1))
Print #1, " <tr>"
For iCol = 1 To 6
If iCol <> 2 Then
Print #1, " <td align=center>" & Cells(iRow, iCol).Value & "</td>"
Else
Print #1, " <td>" & Cells(iRow, iCol).Value & "</td>"
End If
Next iCol
Print #1, " <td align=center>"
Print #1, Cells(iRow, 7).Value & Cells(iRow, 8).Value & Cells(iRow, 9).Value
Print #1, " </td>"
For iCol = 10 To 11
Print #1, " <td align=center>" & Cells(iRow, iCol).Value & "</td>"
Next iCol
Print #1, " </tr>"
iRow = iRow + 1
Loop
Print #1, "</table>"
Print #1, "</center>"
Print #1, "<hr color=#ff0000>"
Print #1, "<a href=""mailto:hans@herber.de"">hans@herber.de</a>"
Print #1, "</body>"
Print #1, "</html>"
Close
MsgBox "Die Tabelle wurde gespeichert unter:" & vbLf & sFile
End Sub