Höchster Sieg & Niederlage

SK Puntigamer Sturm Graz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Servus Heinz,
ich hab mal folgendes Makro gebastelt und getestet. Funktioniert bei mir eigentlich sehr gut mit deiner Datei.
2 Dinge sind zu beachten, du hast die Gültigkeitsliste auf drei verbundene zellen bezogen (B1 : D1), damit das Makro läuft musss die Eingabe in B1 erfolgen und die zellen dürfen nicht verbunden sein.
weiter hat es mir die Gültigkeitsliste rausgehauen, weiß aber nicht warum, evtl. hängt das mit dem Verbinden der Zellen zusammen, da müsstest du mal schauen.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim z As Integer, maximum As Integer, diff As Integer, diff1 As Integer, z1 As Integer, wert As _ Integer, z3 As Integer, z4 As Integer, max1 As Integer, z5 As Integer, z6 As Integer, wert1 As Integer, zx As Integer, min1 As Integer Dim s As String, s1 As String, s2 As String, s4 As String, s3 As String, s5 As String On Error Resume Next If Target.Address = "$B$1" Then Application.ScreenUpdating = False Range("J2:J38").ClearContents Range("L2:l38").Interior.ColorIndex = xlNone Range("L2:L38").ClearContents If Target.Value "" Then For z = 3 To 38 Step 1 If Cells(z, 5).Value = Target.Value Then diff = Cells(z, 7).Value - Cells(z, 9).Value Cells(z, 10).Value = diff Else diff1 = Cells(z, 9).Value - Cells(z, 7).Value Cells(z, 10).Value = diff1 End If Next z maximum = Application.WorksheetFunction.Max(Range("J2:J38")) s = Range("J2:J38").Cells.Find(what:=maximum, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False).Row If maximum = 0 Then Range("L" & s).Value = "" Else Range("L" & s).Value = "Höchster Sieg" End If minimum = Application.WorksheetFunction.Min(Range("J2:J38")) s1 = Range("J2:J38").Cells.Find(what:=minimum, SearchOrder:=xlByColumns, SearchDirection:= _ xlNext, MatchCase:=False).Row If minimum = 0 Then Range("L" & s1).Value = "" Else Range("L" & s1).Value = "Höchste Niederlage" End If s2 = Range("L2:L38").Find(what:="Höchster Sieg", SearchOrder:=xlByColumns, SearchDirection:= _ xlNext, MatchCase:=False).Row wert = Range("J" & s2).Value For z1 = 3 To 38 Step 1 If Cells(z1, 10).Value = wert Then Range("L" & z1).Value = "Höchster Sieg" End If Next z1 s3 = Range("L2:L38").Find(what:="Höchste Niederlage", SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False).Row wert1 = Range("J" & s3).Value For z5 = 3 To 38 Step 1 If Cells(z5, 10).Value = wert1 Then Range("L" & z5).Value = "Höchste Niederlage" End If Next z5 For z3 = 3 To 38 Step 1 If Cells(z3, 12).Value = "Höchster Sieg" Then If Cells(z3, 5).Value = Range("B1").Value Then Cells(z3, 13).Value = Cells(z3, 7).Value + Cells(z3, 10).Value Else Cells(z3, 13).Value = Cells(z3, 9).Value + Cells(z3, 10).Value End If End If Next z3 For zx = 3 To 38 Step 1 If Cells(zx, 12).Value = "Höchste Niederlage" Then If Cells(zx, 5).Value = Range("B1").Value Then Cells(zx, 14).Value = Cells(zx, 7).Value + Cells(zx, 10).Value * -1 Else Cells(zx, 14).Value = Cells(zx, 9).Value + Cells(zx, 10).Value * -1 End If End If Next zx max1 = Application.WorksheetFunction.Max(Range("M3:M38")) s4 = Range("M2:M38").Find(what:=max1, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False).Row Range("L" & s4).Interior.ColorIndex = 4 min1 = Application.WorksheetFunction.Max(Range("N3:N38")) s5 = Range("N3:N38").Find(what:=min1, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False).Row Range("L" & s5).Interior.ColorIndex = 3 For z4 = 3 To 38 Step 1 If Cells(z4, 12).Interior.ColorIndex 4 And Cells(z4, 12).Interior.ColorIndex 3 Then Cells(z4, 12).ClearContents End If Next z4 Range("M3:M38").ClearContents Range("N3:N38").ClearContents End If Application.ScreenUpdating = True End If End Sub

Das Makro schreibt jeweils hinter das jeweilige betroffene Spiel Höchster Sieg oder Höchste Niederlage und färbt diese entsprechend ein, wenn gleiche tordifferenzen bestehen wird das Spiel mit den meist geschossenen bzw. bekommenen Toren genommen.
s. Bspdatei
https://www.herber.de/bbs/user/44348.xls
gruß
Chaos

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Höchster Sieg & Niederlage

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread