Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Fußballergebnisse in Tabelle eintragen und zu HTML konvertieren

Gruppe

Internet

Problem

Wie kann ich Fußballergebnisse eines Spieltages in eine Tabelle eintragen, die Tabelle aktualisieren und nach HTML konvertieren?

Lösung

Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

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