Ich möchte in a1-4 Platz 1 bis 4 stehen haben und dahinter
aktualisiert sich immer je nach Ergebnis die
Mannschaften.Punkte usw.
Auch hier bleiben links die Namen immer fest an ihrem platz,
nur der Rest ändert sich je nach Tip-Ergebnis.
Auch dieses hätte ich gerne so, dass links Platz 1 bis 9 steht
und sich rechts davon alles automatisiert.
Hi stefan,
wenn dein blatt1 so aussieht:
A B C D E F G H I J K L M N
10 Portugal Griechenland platz team g v u t+ t- td pkt
11 Spanien Russland 1
12 Griechenland Spanien 2
13 Russland Portugal 3
14 Russland Griechenland 4
15 Spanien Portugal
sieht es nach Eingabe von Ergebnissen automatisch so aus:
A B C D E F G H I J K L M N
10 Portugal Griechenland 5 5 platz team g v u t+ t- td pkt
11 Spanien Russland 5 3 1 Spanien 2 0 0 9 5 4 6
12 Griechenland Spanien 2 4 2 Griechenland 1 1 1 11 10 1 1
13 Russland Portugal 1 0 3 Portugal 0 1 1 5 6 -1 -2
14 Russland Griechenland 1 4 4 Russland 1 2 0 5 9 -4 -3
15 Spanien Portugal
wenn du die nachfolgenden Makros benutzt.
Die Makros gehen davon aus, dass ein Blatt „Tabelle1“ und ein „Tabelle2“ existiert. „Tabelle2“ wird nur zum Sortieren benutzt.
Bei Benutzung anderer Namen musst du in den Codes alle Vorkommen von „Tabelle1“ gegen „andererName“ austauschen, dsgleichen für „Tabelle2“
In „Tabelle1“ klickst du mit rechts unten auf den tabellennamen, dann auf Code anzeigen. Du bist jetzt im Modulfenster von „Tabelle1“. Dorthinein kopierst du den Code von Private Sub Worksheet_Change(ByVal Target As Range) und änderst wie nachstehend beschrieben den Code ab.
Danach oben auf „Einfügen—Modul“, jetzt bist du im Modul von Modul1,
dorthinein kopierst du den Code von sub Berechnung(…). Auch das Option Base 1 mitkopieren.
Die makros gehen davon aus dass Gruppe1 in den Zeilen 10-15 stehen, Gruppe2 in den Zeilen 20-25 usw. Wenn du andere Zeilen willst musst du im ersten Makro die Anfangszeile dementsprechend ändern.
In dem ersten Makro musst du sowieso noch die Namen der anderen Gruppen entsprechend zu Gruppe 1 eintragen.
Gruß
Reinhard
Private Sub Worksheet\_Change(ByVal Target As Range)
If Target.Column 4 Then Exit Sub 'nur reagieren wenn zweites ergebnis eingetragen
Select Case Target.Row
Case 10 To 15 ' gruppe1
Berechnung 10, "Portugal", "Spanien", "Griechenland", "Russland"
Case 20 To 25 ' gruppe2
Berechnung 20, "Portugal", "Spanien", "Griechenland", "Russland"
Case 30 To 35 ' gruppe3
Berechnung 30, "Portugal", "Spanien", "Griechenland", "Russland"
Case 40 To 45 ' gruppe4
Berechnung 40, "Portugal", "Spanien", "Griechenland", "Russland"
Case 50 To 55 ' gruppe5
Berechnung 50, "Portugal", "Spanien", "Griechenland", "Russland"
Case 60 To 65 ' gruppe6
Berechnung 60, "Portugal", "Spanien", "Griechenland", "Russland"
End Select
End Sub
Option Base 1
Sub Berechnung(zei As Long, m1 As String, m2 As String, m3 As String, m4 As String)
Application.ScreenUpdating = False
Dim wert(4, 8)
wert(1, 1) = m1
wert(2, 1) = m2
wert(3, 1) = m3
wert(4, 1) = m4
With Worksheets("Tabelle1")
For n = 1 To 4
For m = zei To zei + 5
If .Cells(m, 1) = wert(n, 1) And .Cells(m, 4) "" Then 'heim
wert(n, 2) = wert(n, 2) + ((.Cells(m, 3) - .Cells(m, 4)) \> 0) \* -1 'g
wert(n, 3) = wert(n, 3) + ((.Cells(m, 3) - .Cells(m, 4)) "" Then 'gast
wert(n, 2) = wert(n, 2) + ((.Cells(m, 3) - .Cells(m, 4)) 0) \* -1
wert(n, 4) = wert(n, 4) + ((.Cells(m, 3) - .Cells(m, 4)) = 0) \* -1
wert(n, 5) = wert(n, 5) + .Cells(m, 4) '+T
wert(n, 6) = wert(n, 6) + .Cells(m, 3) '-T
End If
Next m
wert(n, 7) = wert(n, 5) - wert(n, 6) 'TD
wert(n, 8) = 3 \* wert(n, 2) - 3 \* wert(n, 3) + wert(n, 4) 'pkt
Next n
With Worksheets("Tabelle2")
.Range(.Cells(zei + 1, 1), .Cells(zei + 4, 8)) = wert()
.Range(.Cells(zei + 1, 1), .Cells(zei + 4, 8)).Sort \_
Key1:=.Cells(zei + 1, 8), Order1:=xlDescending, \_
Key2:=.Cells(zei + 1, 7), Order2:=xlDescending, Header:=xlNo, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Range(.Cells(zei + 1, 1), .Cells(zei + 4, 8)).Copy
End With
.Paste Destination:=.Range(.Cells(zei + 1, 7), .Cells(zei + 4, 14))
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
