VBA - Tabelle mit Mannschaftsergebnissen sortieren

Hallo,

aus einer umfangreichen Tabelle mit unsortierten Ergebnissen von Mannschaftsmitgliedern eines Sportvereins habe ich zur Erstellung einer Ergebnisliste die Daten in eine gesonderte Tabelle übernommen, die für eine Mannschaftsergebnisliste erforderlich sind. Jede Mannschaft besteht aus 3 Mitgliedern, denen eine Mannschaftsnummer und die Buchstaben a, b und c zugeordnet sind. Die Tabelle, die im ersten Schritt nach diesen Mannschaftsnummern sortiert ist, soll nun für eine Ergebnisliste im nächsten Schritt nach der Disziplinnummer, Mannschaftsklasse und dem Mannschaftsergebnis (Summe der 3 Mannschaftsmitglieder) sortiert werden. Ich habe mit meinen bescheidenen VBA-Kenntnissen ein Makro entwickelt, das auch dieses Ziel erreicht (siehe Musterdatei https://www.herber.de/bbs/user/168844.xlsm ).

Vor der Sortierung ist allen 3 Mannschaftsmitgliedern mit einer Formel das gleiche Mannschaftsergebnis zugeordnet worden. Genau das ist mein Problem. Ich habe in der Musterdatei die Formel händisch in die Hilfsspalte P eingetragen. Ich weiß nicht, wie ich das mit einem Makro hinbekommen soll. Hat jemand eine Lösung?

Noch eine Anmerkung: Die Anzahl der Mannschaften ist je nach Veranstaltung unterschiedlich.

Schon einmal vielen Dank.

Viele Grüße
Franz

Hallo

upps, ich sehe es gibt schon drei Antworten der Kollegen, will aber meinen Code nicht in die Tonne kloppen!
Ich habe dir in deinen Code ein Makro für die Summen Formeln eingesetzt, und teile deines Codes verkürzt.
Ich hoffe das er in dieser Kurzfassung noch einwandfrei läuft. Dich wird vielleicht diese Codezeile wundern.
Range("R4").Copy Range("R5:R" & Zei21) - So kopiert man Formeln oder Werte OHNE PasteSpecial.

mfg Piet

'neu eingefügt für Formelmakro

Dim AC As Range, lz1 As Long

Dim FAdr As String, n As Long

Dim Adr As String, Edr As String

'

' ***  Codes für Mannschaftsliste  ***

'-------------------------------------------------------------------------------------------------------

'

Sub Mannschaftsliste_erstellen()

    Dim Zei21 As Integer



    ActiveSheet.Unprotect

    Application.ScreenUpdating = False

    Worksheets("Mannschaften").Activate

'

' ** Ermitteln der letzten Zeile der Tabelle **

'

        Zei21 = Cells(Rows.Count, 3).End(xlUp).Row

'        MsgBox Zei21

'

' ** Einfügen der Formel zur Ermittlung des Mannschaftsergebnisses in Hilfsspalte P **

'

    '1. Formel + Summen Adresse setzen

    Adr = "$M$4": FAdr = "P4": n = 1

    

    'alle Klassen als Summe auswerten

    For Each AC In Range("F4:F" & Zei21)

        If AC.Cells(2, 1) > AC.Value Then

           Edr = Cells(AC.Row, "M").Address      'End Adresse

           Range(FAdr).Resize(n, 1).FormulaLocal = "=SUMME(" & Adr & ":" & Edr & ")"

           Adr = Cells(AC.Row + 1, "M").Address  'neue Anf-Adresse

           FAdr = Cells(AC.Row + 1, "P").Address: n = 1  '1.Formel Zelle

        Else: n = n + 1   'Zeilenzähler

        End If

    Next AC

        

' ** Kopieren der Disziplinnummern, Einfügen in Hilfsspalte Q und Entfernen der Punkte **

'

        Range("C4:C" & Zei21).Copy

        Range("Q4").PasteSpecial Paste:=xlPasteValues

        Application.CutCopyMode = False

        Range("Q4:Q" & Zei21).Replace ".", "", xlPart

        

' ** Entfernen der letzten 2 Stellen der Disziplinnummer für das Sortieren (Hilfsspalte R) **

'

        Range("R4").FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-2)"

        Range("R4").Copy Range("R5:R" & Zei21)

            

' ** Sortieren nach Disziplinnummer (Hilfsspalte R), M-Klasse (Spalte F) und M-Ergebnis (Hilfsspalte P)

        With ActiveWorkbook.Worksheets("Mannschaften")

             .SortFields.Clear

             .Range("B4:R" & Zei21).Sort _

                Key1:=.Range("R4"), order1:=xlAscending, _

                Key2:=.Range("F4"), Order2:=xlAscending, _

                Key3:=.Range("P4"), Order3:=xlDescending, _

                Header:=xlNo

        End With

'

' ** Platzierungen der Mannschaft zu jedem Mannschaftsmitglied einfügen **



    Range("N4").FormulaR1C1 = "=IF(RC[-1]="""","""",1)"

    Range("N5").FormulaR1C1 = "=IF(RC[-1]="""","""",IF(OR(R[-1]C[-10]>RC[-10],R[-1]C[-8]>RC[-8]),1,IF(AND(R[-1]C[-10]=RC[-10],R[-1]C[-8]=RC[-8],LEFT(R[-1]C[-9],LEN(R[-1]C[-9])-1)=LEFT(RC[-9],LEN(RC[-9])-1)),R[-1]C,R[-1]C+1)))"

    Range("N5").Copy Range("N6:N" & Zei21)

    Application.CutCopyMode = False

        

    Range("A1").Select

    Application.ScreenUpdating = True

End Sub

VBA - Tabelle mit Mannschaftsergebnissen sortieren

Forumthread: VBA - Tabelle mit Mannschaftsergebnissen sortieren

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

VBA - Tabelle mit Mannschaftsergebnissen sortieren

Forumthread: VBA - Tabelle mit Mannschaftsergebnissen sortieren

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread