RSS-Feeds zu Office abonnieren
Hattrick-Jugend (Programmierung, Bedingte Abhängigkeiten) - (Überarbeitet 08/2021)
Es gibt ein Browserspiel Namens "Hattrick". Das spiele ich nun schon seit 2004. Es ist sehr taktisch, mit spärlicher Grafik, aber es macht Spaß sich mit Tausenden anderen Fußballverrückter Woche auf Woche neu zu messen.
In diesem Browserspiel gibt es auch die Möglichkeit eine Jugendmannschaft zu managen. Um dort für ein wenig Übersicht zu sorgen habe ich dieses Excelsheet erstellt. Für jemanden, der nichts mit dem Spiel am Hut hat, könnte das Sheet dennoch insofern interessant sein, da ich hier sehr viele spannende Dinge eingebaut habe. Zum Beispiel
- Sehr viele bedingte Formatierungen
- VBA: Verschiedene Sprachen auswählen
- Deutsch
- Englisch
- Spanisch
- VBA: Neue Spieler direkt einfügen - Zeichenkettenverarbeitung und Automatisierung
- VBA: Spieler verschieben
- VBA: Zeilenhighlighting
- Hilfe zur Bedienung
- Und einiges mehr...
Im Tab "Dokumentation" gehe ich näher auf einige einzelne Bereiche ein.
- Die Tabelle hat geschützte Bereiche, die aber ohne Passwort versehen sind und durch einfaches anklicken im Menüband ÜBERPRÜFEN, Gruppe Änderungen, Blattschutz aufheben frei gemacht werden können. Wird der Blattschutz entfernt, ist es wichtig, dass nun beim Zeilenlöschen dieser Bereich nicht mit markiert wird, da sonst die Formeln mit gelöscht werden und somit die Altersberechnung nicht mehr funktionieren.
- Der Download-Sheet beinhaltet eine Beispiel- und eine leere Tabelle.
- Es befinden sich ein paar Makros im Sheet. Der Code dafür wird im Tab "Code - Makros" erklärt.
- Das Kopieren der einzelnen Zeilen funktioniert erst ab Spalte "E", da vorher der geschützte Altersbereich ist und davor verbundene Zeilen. Das anklicken einer ganzen Zeile zum Kopieren funktioniert also nicht. Im Sheet befindet sich jedoch ein Makro, das mit dem Button "Verschieben" erreichbar ist. Mit dem können Sie stets die ganze Zeile kopieren, egal wo Sie mit der Maus hineinklicken.
Klicken Sie danach in eine neue Zeile, wird der Inhalt der zuvor ausgewählten und zu kopierenden Zeile automatisch dort hinkopiert und die Ursprungszeile gelöscht. Details im Sheet. - Möchten Sie nur die Zeile markieren, weil Sie sie löschen wollen, können Sie ein "Zeilen-Lösch-Makro" mit dem zugehörigen Button aufrufen.
Der Trainer meldet immer, was der Jugendspieler erreichen kann oder tatsächlich erreicht hat und manchmal tut er uns kund, dass sich ein Spieler in einem bestimmten Bereich nicht mehr entwickeln kann. Jeder Spieler hat in jedem Aufstellungsbereich (Tor, Verteidigung, Mittelfeld, Angriff, Passspiel und Standards) einen entsprechenden Überblick über seine maximalen und tatsächlichen Werte.
Im Bild bedeutet das von oben bis unten:
- Linke Spalte jeweils der tatsächliche Wert und in der rechten Spalte der maximale Wert
- Tatsächlich: 5, maximal: 6 - da geht noch was. Der Spieler hat den tatsächlichen Wert in Grün dargestellt, weil hier noch Trainingspotenzial offen ist.
- Tatsächlich: 6, maximal: 6 - der Spieler hat seinen Maximalwert erreicht. Ein Training ist hier nicht mehr effektiv, weshalb der tatsächliche Wert in Rot dargestellt wird.
- Tatsächlich: 6, maximal: unbekannt - da der Maximalwert unbekannt ist, ist auch unklar, ob der Spieler hier noch trainiert werden kann. Der Wert ist in Lila und der Hintergrund ist optisch gesperrt. Die Situation ist unklar.
- Tatsächlich: unbekannt, maximal: 6 - Der Hintergrund ist quasi bereit für den tatsächlichen Wert, bleibt aber natürlich leer, da dieser Wert noch unbekannt ist. Hier ist eventuell noch Training sinnvoll.
- Tatsächlich: unbekannt, maximal: unbekannt - Der Hintergrund des tatsächlichen Wertes bleibt optisch gesperrt (natürlich kann aber eine Zahl eingetragen werden). Situation völlig unklar.
Das Alter der Spieler wird automatisch berechnet und es wird angezeigt, wenn der Spieler ein Jahr älter geworden ist, 18 ist oder auch so alt, dass er nicht mehr aufgestellt werden kan.
Der Spieler Vitali Habdank, übrigends ein Kopfballstarker Spieler, wie uns das "K" verrät, ist 15 Jahre und 13 Tage alt.
Der Spieler ist 18 Jahre alt und sein Name wird nun in roter Schrift angezeigt. Eine Saison kann er nun noch spielen. Es wird also eng mit dem Training und für die Position sollte nun rechtzeitig Ersatz gesucht werden.
Mit 19 kann er nicht mehr in der Jugend aufgestellt werden und sollte nun in die erste Mannschaft befördert oder entlassen werden. Sein Name ist durchgestrichen.
Die höchsten und niedrigsten Werte werden mit einer Fahne dargestellt (grün, rot und gelb für die mittleren Werte). So kann schnell gesehen werden, für welcher Position der Spieler am besten geeignet ist.
Mit dem unteren Button lässt sich die Sprache einstellen. Derzeit gibt es Englisch, Deutsch und Spanisch zur Auswahl. Wobei ich selber dafür Google Translator benutzt habe, da ich leider keine Fremdsprache spreche...
Die Zeile, in die geklickt wurde, wird farblich hervorgehoben. Da rechts die Tore eingetragen werden können, kann so stets der richtige Spieler ausgewählt werden. Ein müsehliges überprüfen, ob man in der richtigen Zeile steht, entfällt somit.
' ************
' Ein Jahr älter!
' Geburtstag automatisieren beim Start des Sheets
' ************
Dim AltDif As Integer
Dim Zugehoerigkeit As Integer
Dim i As Byte, z As Byte, TabellenAnzahl As Byte
TabellenAnzahl = Worksheets.Count - 1
For z = 1 To TabellenAnzahl
For i = 3 To 37
If Worksheets(z).Range("AL" & i).Value <> "" Then
If Worksheets(z).Range("AL" & i).Value < Date Then
Worksheets(z).Range("AL" & i).Value = Worksheets(z).Range("AL" & i).Value + 112
Worksheets(z).Range("AK" & i).Value = Worksheets(z).Range("AK" & i).Value + 1
End If
End If
Next i
Next z
' ************
' Es geht noch weiter bevor die Sub geschlossen wird
' ************
Beim Start des Sheets wird das Alter der Spieler abgeprüft und gegebenenfalls neu berechnet. Dieser Vorgang ist automatisiert und wird beim Start automatisch aufgerufen, da es sich um ein Excel-Ereignis handelt: Private Sub Workbook_Open()
Da ich nicht weiß, wieviele Jugendmannschaften vorhanden sind und somit Tabellenblätter, zähle ich mit Worksheet.Count zunächst die Tabellenblätter im Arbeitsblatt. -1 deswegen, weil ich eine "unsichtbare" Tabelle im Sheet habe. Die Tabelle "Daten" ist ausgeblendet und kann jederzeit mit der rechten Maustaste auf dem Tab mit den Tabellen eingeblendet werden. Danach mache ich eine Schleife über die vorhandenen Tabellen und prüfe jeweils die Geburtstagsspalte ab. Zeile für Zeile.
In Date steht immer das aktuelle Datum. Also die Excelentsprechung von Heute().Liegt der Geburtstag in der Vergangenheit (Value < Date), dann muss der nächste Geburstag ermittelt werden und das Alter einen hoch gezählt werden. Das Hattrickjahr dauert 112 Tage, weshalb ich hier entsprechend das neue Datum ausrechne: Worksheets(wi).Range("AN" & i).Value + 112
' Ab wann kann er in die 1. Mannschaft befördert werden?
' ************
For z = 1 To TabellenAnzahl
For i = 3 To 37
Worksheets(z).Cells(i, 2).Value = ""
If Worksheets(z).Cells(i, 39).Value <> "" And Worksheets(z).Cells(i, 38).Value <> "" Then
AltDif = Worksheets(z).Cells(i, 38).Value - Date
Zugehoerigkeit = Date - Worksheets(z).Cells(i, 39).Value
If Worksheets(z).Cells(i, 37).Value = "15" Then
AltDif = Worksheets(z).Cells(i, 38).Value - Date
Worksheets(z).Cells(i, 2).Value = AltDif + 112
ElseIf Worksheets(z).Cells(i, 37).Value = "16" Then
If AltDif > (112 - Zugehoerigkeit) Then
Worksheets(z).Cells(i, 2).Value = AltDif
Else
Worksheets(z).Cells(i, 2).Value = 112 - Zugehoerigkeit
End If
Else
Worksheets(z).Cells(i, 2).Value = 112 - Zugehoerigkeit
End If
If Worksheets(z).Cells(i, 2).Value <= "0" Then Worksheets(z).Cells(i, 2).Value = "»"
End If
Next
Next z
Jugendspieler können nach 112 Tagen Zugehörigkeit und wenn sie mindestens 17 Jahre alt sind, in die A-Mannschaft befördert werden.
Das lässt sich im Excelsheet mit verschachtelten WENN-Bedingungen darstellen. Allerdings wird es schnell unübersichtlich, weshalb ich mich entschlossen habe, ein Makro dazu zu schreiben.
Die äußeren Schleifen sind identisch zum Geburtstag. Auch wird die Berechnung direkt nach dem Start automatisch durchgeführt.
Mit Worksheets(wi).Range("B" & i).Value = "" setze ich zunächst die Zelle auf leer. Hat der Spieler kein Eintrittsdatum wird auch nichts berechnet. Das Eintrittsdatum steht bei der Einzelansicht des Spielers in Hattrick. Danach frage ich das Alter ab. Da der Spieler erst mit 17 befördert werden kann, ist es im zarten Alter von 15 Jahren recht einfach. Das gesamte 16te Alter (also 112 Tage = 1 Hattrickjahr) plus der Differenz zwischen dem heutigen Datum und seinem nächsten Geburtstag (was ich in der Variable AltDif festgehalten habe).
Ist der Spieler 16 ist es etwas komplizierter, da geklärt werden muss, ob er mit Erreichen seines 17. Geburtstages bereits 112 Tage Vereinszugehörigkeit vorhanden sind oder daran noch einige Tage fehlen. Ansonsten gilt das Jahr minus seiner Zugehörigkeit.
Kann der Spieler befördert werden, erhält er am Ende statt einer hässlichen Minus-Zahl den Doppelpfeil. In Excel gebe ich eine bedingte Formatierung in dieser Spalte vor: Steht dort ein Doppelpfeil lege einen grünen Hintergrund mit weißer Schrift in die Zelle.
Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 39)).ClearContents
End Sub
Wenn ein Spieler gelöscht werden soll, wird dieses Makro per Button unter der Tabelle aufgerufen. Da einige Spalten gesperrt sind und die erste Spalte sich über mehrere Zeilen verteilt, kann nicht "per Hand" eine Zeile gelöscht werden, sondern muss per Makro ausgeführt werden. Es wird also die Zeile ab Spalte 5 bis Spalte 39 gelöscht. Die Spalten 2 bis 4 werden berechnet und sind daher nach dem nächsten Start der Tabelle automatisch gelöscht.
Sub Zeile_markieren()
' ************
' Erste Zeile wird markiert
' Nach anklicken einer zweiten Zeile wird "Private Sub Workbook_SheetSelectionChange(...)" aufgerufen
' und die erste (diese) Zeile dort hin kopiert und gelöscht
'
' Tastenkombination: Strg+z
' ************
Set rQuelle = Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 39))
intUrsprungzeile = ActiveCell.Row
End Sub
Möchten Sie einen Zeile verschieben, dann gibt es unten einen Button Namens "Verschieben". Dieser Button ruft dieses Makro auf.
In rQuelle wird die Zeile gespeichert und in intUrsprungzeile die aktuelle Zeilennummer.
Benötigt wird das dann im nachfolgenden Aufruf.
Dim rZiel As Range
Dim i As Byte
If intUrsprungzeile > 2 And ActiveCell.Row <> intUrsprungzeile Then
Set rZiel = Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 39))
For i = 1 To rQuelle.Cells.Count
rZiel(i) = rQuelle(i)
Next i
Range(Cells(intUrsprungzeile, 5), Cells(intUrsprungzeile, 39)).ClearContents
intUrsprungzeile = 0
End If
End Sub
Dieses Makro wird automatisch aufgerufen, wenn mit der Maus irgendwo hin geklickt wird. Es handelt sich um ein Ereignis.
Am Anfang wird überprüft, ob sich der Mauszeiger mindestens in Zeile 3 befindet und ob ich mich in einer neuen Zeile befinde, die ungleich zu meiner Variable intUrsprungzeile ist.
In rZiel wird die neue Position eingetragen, die an dieser Stelle noch leer ist. In rQuelle steht der Inhalt der zu verschiebenen Zeile. Da ich die Daten nicht als selektionierte Range übertragen kann, musste ich den Inhalt in ein Array zwischenspeichern (rQuelle) und schreibe nun den Inhalt der Quelle in das Ziel. Mit der Schleife spreche ich die einzelnen Positionen/Elemente des Array an.
Beispiel:
Angenommen Sie möchten Zeile 15 woanders hinkopieren. Dann positionieren Sie den Mauszeiger in eben dieser Zeile und rufen das Makro per Button auf. Der Inhalt von Zeile 15 wird nun kopiert. Wenn Sie nun mit der Maus beispielsweise in Zeile 8 klicken, wird der Inhalt von Zeile 15 in Zeile 8 geschrieben und in Zeile 15 gelöscht. In intUrsprungzeile steht der Wert 15.
Am Ende weise ich der globalen Variablen intUrsprungszeile den Wert 0 zu. Da das Ereignis SheetSelectionChange immer ausgeführt wird, wenn in eine Zelle geklickt wird, habe ich am Anfang festgelegt, dass dieses Ereignis nur dann abgearbeitet wird, wenn intUrsprungszeile ungleich 0 ist.
If Cells(ActiveCell.Row, 7).Value = "" And AlteFarbe = 0 Then Exit Sub
If AlteZeile <> 0 Then
Range(Cells(AlteZeile, 5), Cells(AlteZeile, 39)).Interior.Color = AlteFarbe
If AlteZeile >= 6 And AlteZeile <= 12 Then Range(Cells(AlteZeile, 11), Cells(AlteZeile, 16)).Interior.Color = 9944516
If AlteZeile >= 13 And AlteZeile <= 20 Then Range(Cells(AlteZeile, 17), Cells(AlteZeile, 21)).Interior.Color = 12040422
If AlteZeile >= 21 And AlteZeile <= 25 Then Range(Cells(AlteZeile, 22), Cells(AlteZeile, 25)).Interior.Color = 12379352
If AlteZeile >= 26 And AlteZeile <= 30 Then Range(Cells(AlteZeile, 26), Cells(AlteZeile, 29)).Interior.Color = 14336204
End If
AlteFarbe = Cells(ActiveCell.Row, 5).Interior.Color
Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 39)).Interior.Color = 65535
AlteZeile = ActiveCell.Row
End Sub
Wird in eine Zeile geklickt, wird diese gelb hinterlegt. Und nach dem Anklicken einer neuen Zeile natürlich auch wieder in den Ursprung zurückversetzt. Für den Code benutze ich die Ereignissteuerung in den Tabellen.
Eigentlich ist der Code recht simpel. Die Farbzuweisung findet in dieser Zeile statt:
Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 39)).Interior.Color = 65535
"65535" ist die Farbe Gelb. Es wird die aktive Zeile von Spalte 5 bis Spalte 39 gelb eingefärbt.
Wenn ich in eine neue Zeile klicke, dann muss die alte Hintergrundfarbe wieder zurückgeschrieben werden. Die Farbe selber steht in der Variablen AlteFarbe und in AlteZeile steht die letzte Zeile drin. SO kann bequem der Urzustand hergestellt werden. Allerdings gibt es ein kleines Problem, da einige Bereiche leicht von der eigentlichen Ursprungs-Hintergrundfarbe abweichen. Das wird in dem Block erledigt, der abfragt in welcher Zeile genau die AlteZeile stand, um dann einige Spalten mit einer anderen Hintergrundfarbe zu versehen.
Dim i As Byte, TabellenAnzahl As Byte
TabellenAnzahl = Worksheets.Count - 3
For i = 1 To TabellenAnzahl
'Seitentext Spalte A
Worksheets(i).Range("A3").Value = Worksheets("Daten").Cells(3, Spalte).Value
Worksheets(i).Range("A6").Value = Worksheets("Daten").Cells(4, Spalte).Value
Worksheets(i).Range("A13").Value = Worksheets("Daten").Cells(5, Spalte).Value
Worksheets(i).Range("A21").Value = Worksheets("Daten").Cells(6, Spalte).Value
Worksheets(i).Range("A26").Value = Worksheets("Daten").Cells(7, Spalte).Value
Worksheets(i).Range("A31").Value = Worksheets("Daten").Cells(8, Spalte).Value
'Tabellenüberschriften - Linker Bereich (Name...)
Worksheets(i).Range("B1").Value = Worksheets("Daten").Cells(9, Spalte).Value
Worksheets(i).Range("C1").Value = Worksheets("Daten").Cells(10, Spalte).Value
'Und noch einiges mehr an Code!
Wer sich für die Sprachauswahl interessiert, den muss ich bitten, sich den Excelsheet herunterzuladen, da der Code etwas umfassender ist und sich auch beinahe durch den ganzen Excelsheet verteilt.
Es gibt ein Modul, welches nur für die Sprache zuständig ist. Ein weiterer Bereich ist "Diese Arbeitsmappe", wo bei Neustart die ausgewählte Sprache ermittelt wird.
Dazu gehört auch die UserForm ufSprachauswahl.
' ************
'Zeichenkette in Tabelle "Spieler Neu" auslesen und zuordnen
' ************
Dim strName As String, dateGeburtstag As Date, strAlter As String, strVerein As String
Dim dateSeit As Date
Dim TorTat As String, TorMax As String
Dim VTTat As String, VTMax As String
Dim MFTat As String, MFMax As String
Dim FLTat As String, FLMax As String
Dim PassTat As String, PassMax As String
Dim SchussTat As String, SchussMax As String
Dim StandTat As String, StandMax As String
Dim strSpezi As String
Dim pos As Long, pos_end As Long, i As Byte, z As Byte 'z gibt die Zeile zurück, falls eine Spezialität vorhanden ist
Dim strZ As String, strZwischen As String
Dim bolVorhanden As Boolean
On Error Resume Next
'Spieler aus Zwischenablage kopieren
Range("A1").Select
ActiveSheet.Paste
z = 9
'Name auslesen
strName = Range("a1").Value
pos = InStr(1, strName, "[")
strName = Left(strName, pos - 1)
'Alter und Geburtstag
strAlter = Left(Range("a2").Value, 3)
pos = InStr(1, Range("a2").Value, ":")
dateGeburtstag = Right(Range("a2").Value, Len(Range("a2").Value) - pos)
dateSeit = Right(Range("a5").Value, 10)
'Spezialität
If Range("A8").Value <> "" Then
pos = InStr(1, Range("A6").Value, ":") + 2
strSpezi = Mid(Range("A6").Value, pos, 2)
z = 10
End If
'Fähigkeiten
strZ = Cells(z, 1).Value
pos = InStr(1, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then TorTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then TorMax = Mid(strZ, pos - 2, 1)
End If
pos = InStr(pos + 5, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then VTTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then VTMax = Mid(strZ, pos - 2, 1)
End If
pos = InStr(pos + 5, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then MFTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then MFMax = Mid(strZ, pos - 2, 1)
End If
pos = InStr(pos + 5, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then FLTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then FLMax = Mid(strZ, pos - 2, 1)
End If
pos = InStr(pos + 5, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then PassTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then PassMax = Mid(strZ, pos - 2, 1)
End If
pos = InStr(pos + 5, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then SchussTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then SchussMax = Mid(strZ, pos - 2, 1)
End If
pos = InStr(pos + 5, strZ, "[/td]")
If Mid(strZ, pos - 1, 1) = ")" Then
If Mid(strZ, pos - 4, 1) <> "?" Then StandTat = Mid(strZ, pos - 4, 1)
If Mid(strZ, pos - 2, 1) <> "?" Then StandMax = Mid(strZ, pos - 2, 1)
End If
'Zuordnung zur Tabelle und "Spieler Neu" leeren
pos = InStr(1, Range("A5").Value, ":") + 1
strVerein = Right(Range("A5").Value, Len(Range("A5").Value) - pos)
strZwischen = StrReverse(strVerein)
pos_end = InStr(15, strZwischen, " ")
strVerein = Mid(strVerein, 1, Len(strVerein) - pos_end)
strVerein = Trim(strVerein)
Range("A1:A10").Clear 'Tabelle leeren
Worksheets(strVerein).Activate
bolVorhanden = False
'Werte in die Tabelle schreiben
For i = 3 To 30
If Cells(i, 7).Value = Trim(strName) Then 'Ist der Spieler bereits vorhanden?
bolVorhanden = True
Cells(i, 5).Value = strSpezi
If TorTat <> "" Then Cells(i, 8).Value = TorTat
If TorMax <> "" Then Cells(i, 9).Value = TorMax
If VTTat <> "" Then Cells(i, 11).Value = VTTat
If VTMax <> "" Then Cells(i, 12).Value = VTMax
If MFTat <> "" Then Cells(i, 17).Value = MFTat
If MFMax <> "" Then Cells(i, 18).Value = MFMax
If FLTat <> "" Then Cells(i, 22).Value = FLTat
If FLMax <> "" Then Cells(i, 23).Value = FLMax
If SchussTat <> "" Then Cells(i, 26).Value = SchussTat
If SchussMax <> "" Then Cells(i, 27).Value = SchussMax
If PassTat <> "" Then Cells(i, 30).Value = PassTat
If PassMax <> "" Then Cells(i, 31).Value = PassMax
If StandTat <> "" Then Cells(i, 32).Value = StandTat
If StandMax <> "" Then Cells(i, 33).Value = StandMax
Cells(i - 1, 7).Select 'Durch diesen Trck...
Cells(i, 7).Select '... wird hier die ganze Zeile gelb markiert
Exit For
End If
Next
'Wenn der Spieler noch nicht vorhanden ist, dann wird er an einen freien Platz "Unter Beobachtung" gesetzt
If bolVorhanden = False Then
For i = 31 To 37
If Cells(i, 7).Value = "" Then
Cells(i, 5).Value = strSpezi
Cells(i, 7).Value = strName
If TorTat <> "" Then Cells(i, 8).Value = TorTat
If TorMax <> "" Then Cells(i, 9).Value = TorMax
If VTTat <> "" Then Cells(i, 11).Value = VTTat
If VTMax <> "" Then Cells(i, 12).Value = VTMax
If MFTat <> "" Then Cells(i, 17).Value = MFTat
If MFMax <> "" Then Cells(i, 18).Value = MFMax
If FLTat <> "" Then Cells(i, 22).Value = FLTat
If FLMax <> "" Then Cells(i, 23).Value = FLMax
If SchussTat <> "" Then Cells(i, 26).Value = SchussTat
If SchussMax <> "" Then Cells(i, 27).Value = SchussMax
If PassTat <> "" Then Cells(i, 30).Value = PassTat
If PassMax <> "" Then Cells(i, 31).Value = PassMax
If StandTat <> "" Then Cells(i, 32).Value = StandTat
If StandMax <> "" Then Cells(i, 33).Value = StandMax
Cells(i, 37).Value = strAlter
Cells(i, 38).Value = dateGeburtstag
Cells(i, 39).Value = dateSeit
Cells(i - 1, 7).Select 'Durch diesen Trck...
Cells(i, 7).Select '... wird hier die ganze Zeile gelb markiert
Exit For
End If
Next
End If
End Sub
Das Einfügen eines neuen Spielers oder lediglich die Werte eines vorhandenen Spielers, ist durchzogen von Zeichenkettenverarbeitung. Ich habe versucht den Code unabhängig von der verwendeten Sprache im Spiel zu schreiben. Leider klappt das nicht immer, da die einzelnen Landessprachen einfach zu uneinig sind 😉
Die Zeichenkette kommt in dieser Art an und muss entsprechend ausgewertet und zugeordnet werden:
Lewis Alfonzo [youthplayerid=278173837] 17 Jahre und 41 Tage, nächster Geburtstag: 21.10.2021
Nationalität: El SalvadorAktueller Verein: FC Babosa Junior seit dem 01.12.2020Spezialität: KopfballstärkeGelbe Karten: 0Verletzungen : gesund
[table][tr][th]Torwart[/th][td]unbekannt[/td][/tr][tr][th]Verteidigung[/th][td]unbekannt / [b]passabel[/b]
(?/6)[/td][/tr][tr][th]Spielaufbau[/th][td]erbärmlich / erbärmlich (2/2)[/td][/tr][tr][th]Flügelspiel[/th]
[td]erbärmlich / erbärmlich (2/2)[/td][/tr][tr][th]Passspiel[/th][td]armselig / armselig (3/3)[/td][/tr][tr]
[th]Torschuss[/th][td]erbärmlich / erbärmlich (2/2)[/td][/tr][tr][th]Standards[/th][td]unbekannt[/td][/tr][/table]
Der gesamte Code ist auch etwas umfangreicher. Interessant ist, in der kopierten Zeichenkette etwas zu finden, nach dem gesucht werden kann. Da natürlich nicht überall das gleiche steht, muss hier sehr gewissenhaft vorgegangen werden,. Insbesondere bei der Auswertung der Zeile mit den table-Angaben
Ansonsten wird hauptsächlich mit InStr(), Len(), Right() und Mid() gearbeitet. Und einmal musste ich die Zeichenkette rückwärts mit StrReverse() auswerten.
