HERBERS Excel-Forum - die Beispiele

Thema: Fußballergebnisse in Tabelle eintragen und zu HTML konvertieren

Home

Gruppe

Allgemein

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

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Internet

Text aus Zelle in Internet Seite internet explorer per handle in Objekt umwandeln
InternetExplorer Object Einfügen aus Internet-Seite
Allgemeine Frage zur Fehlerbehandlung allgemeine Fragen zu einer Datenbank
Absturz Excel bei Internet-Absturz Internetdienst mit Makro ausführen
Download aus dem Internet Teil2 Einfügen aus Internet 10²
allgemein Datei aus dem Internet runterladen
XLB Auswirkung auf Internet Explorer Excel standard Symbolleiste im Internet Explorer
internet frage zum RFC Datei im Internet bearbeiten
Internetseite Markieren u. in Tabellenb. kopieren allgemein: VBA lernen?
Hide-Methode-Allgemeine Frage Internetseite aufrufen
Internetseite öffnen + schließen Formelassistent allgemein
Internet Browser_Veraluf löschen allgemeingültig Blattschutz aufheben
Daten Export aus dem internet Email & Internet Adresse
Filesuche auf Internet-Server allgemeine Frage...
Solver - allgemein Solver - allgemein
VBA Download aus Internet / Prüfung ob vorhanden Exeldatei im Internet
Internetseite starten Excel - Internet
Internet Files auslesen Frage zum Forum allgemein
Allgemeine Frage - Finanz-Planungsmodell hile zum internetexplorer.application objekt
Pivoteingrenzung Formel verallgemeinern Internet Explorer starten und Cursor positioneren
Wetter aus dem Internet Internet Explorer geöffnet abprüfen ?
makro verallgemeinern Existiert Internetseite
Office allgemein, bitte hilfe Internetseiten in Exel kopieren
allgemein Automatisches Update übers Internet
internetseite einbetten Internetformular aus Excel heraus ausfüllen