Code optimieren und zusätze einfügen

[michel34497]

Hallo Stefan!

Danke für die Hilfe, funktioniert!
Nun eine neue Frage. Habe mir den Code erweitert ist rot dargestellt. Kann man diesen umschreiben das nicht mehr bei der Berechnung RC drin steht
(Sum = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])" 'Gesamt vom Siel aus Spalte 8, 14, 20, 26, 32 und 38)?

Code:

Private Sub CommandButton3_Click()
   Dim loS As Long
   Dim lngZeile As Long
   Dim arrSpielAuswahl
   Dim arrTreffer
   Dim blnAlle As Boolean
   Dim ctrElement As Control
   Dim Sum As String
   arrSpielAuswahl = Array(3, 9, 15, 21, 27, 33)        ' 1. Spalte des jeweiligen Spiels
   arrTreffer = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 8)  ' Array für die Trefferauswertung
   If cbbSpiel <> "" Then
      ' Schleife über alle Steuerelemente
      For Each ctrElement In Me.Controls
         ' Stuerelement ist eine ComboBox
         If TypeName(ctrElement) = "ComboBox" Then
            ' ComboBox1 - ComboBox5
            Select Case ctrElement.Name
               Case "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5"
                  ' eine der ComboBoxen enthält keine Auswahl
                  If ctrElement = "" Then
                     ' Variable auf True setzen und Schleife verlassen
                     blnAlle = True
                     Exit For
                  End If
            End Select
         End If
      Next ctrElement
      ' alle ComboBoxen haben eine Auswahl
      If blnAlle = False Then
         lngZeile = Range(ComboBox8.RowSource).Cells(1).Row + ComboBox8.ListIndex
         'lngZeile = Range(arrNamen(ComboBox11.ListIndex)).Row + ComboBox8.ListIndex
         With Sheets("Beispiel")
             If ComboBox8.ListIndex > -1 Then
                  loS = arrSpielAuswahl(cbbSpiel.ListIndex)
                  If Application.CountA(.Range(.Cells(lngZeile, loS), .Cells(lngZeile, loS + 5))) > 5 Then
                      MsgBox "Dieser Teilnehmer hat schon 5 Würfe gespielt."
                      Exit Sub
                  Else
                     .Cells(lngZeile, loS) = arrTreffer(ComboBox1.ListIndex)        '1 Wurf vom Spiel
                     .Cells(lngZeile, loS + 1) = arrTreffer(ComboBox2.ListIndex)    '2 Wurf vom Spiel
                     .Cells(lngZeile, loS + 2) = arrTreffer(ComboBox3.ListIndex)    '3 Wurf vom Spiel
                     .Cells(lngZeile, loS + 3) = arrTreffer(ComboBox4.ListIndex)    '4 Wurf vom Spiel
                     .Cells(lngZeile, loS + 4) = arrTreffer(ComboBox5.ListIndex)    '5 Wurf vom Spiel
                     .Cells(lngZeile, loS + 5) = CDbl(TextBox3)                     'Gesamt vom Spiel
                    [color=#FF0000] Sum = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"    'Gesamt vom Siel aus Spalte 8, 14, 20, 26, 32 und 38
                     .Cells(lngZeile, 39) = Sum[/color]
                      If IsNumeric(TextBox4) Then .Cells(lngZeile, 40) = .Cells(lngZeile, 40) + CDbl(TextBox4)
                      If IsNumeric(TextBox5) Then .Cells(lngZeile, 41) = .Cells(lngZeile, 41) + CDbl(TextBox5)
                      If IsNumeric(TextBox6) Then .Cells(lngZeile, 42) = .Cells(lngZeile, 42) + CDbl(TextBox6)
                      If IsNumeric(TextBox8) Then .Cells(lngZeile, 43) = .Cells(lngZeile, 43) + CDbl(TextBox8)
                      UserForm_Initialize
                      Me.TextBox3 = ""
                      Me.TextBox4 = ""
                      Me.TextBox5 = ""
                      Me.TextBox6 = ""
                      Me.TextBox8 = ""
                  End If
             Else
                  MsgBox "Keinen Spieler ausgewählt"
             End If
         End With
      Else
         MsgBox "Bitte für alle Würfe einen Wert auswählen"
      End If
   Else
      MsgBox "Bitte ein Spiel auswählen"
   End If
End Sub

Danke für die Hilfe :100:

[Steffl]

Hallo Michael,

was soll da sonst stehen? Und was hast Du gegen RC?

[michel34497]

Hallo Stefan!
Ich dachte nur es gibt auch noch eine andere Lösung. Ich glaube das Wetter ist schuld an meinen gedanken gängen.
Es funktioniert ja auch so wie ich es dachte.

Aber wie schon angekündigt will ich ja noch eine Auswertung machen. Bin am tüffteln finde aber keine richtigen Lösungsansatz.
Folgendes soll Passieren wenn ich den Button Auswertung im Tabellenblatt Auswertung betätige.
1. Sollen die Namen die in der tabelle Auswertung stehen im Tabellenblatt Beispiel gesucht werden.
Dann schaut er nach wieviel Holz (Spalte AM , Beispiel) die jeweilige Person geworfen hat.
Dieser Wert wird dann in Tabelle Auswertung bei der Person eingetragen.

Ich weis nicht ob man noch einen unterschied zwischen Fauen und Männer Wertung machen sollte.

2. Ist alles eingetragen soll eine Platzierung gemacht werden, damit wir wissen wer erster und letzter ist.
Wenn man dies dann auch gleich sotiren könnte wäre super!

Ich habe grade nur die Frauen und Männer Wertung beschrieben, da die Clubwertung angeblich bei den gesamt Holz anders gerechnet wird. Wenn ich weis wie dies sein soll werde ich mich erneut melden. Doch ersteinmal das beschriebene

Ich hoffe es kann einer helfen!

Tausen Dank!

[Steffl]

Hallo Michael,

auch mir fällt dazu nichts ein. Sehe nur Probleme. Durch die Aufteilung von Name, Vorname und Klub auf drei Spalten, vom Aufteilen nach Geschlecht will ich mal gar nicht reden, weiß ich nicht, wie ich das machen soll, das der Wurf zu richtigen Person im richtigen Klub eingetragen wird. Stelle daher den Thread offen.

Gruß Stefan

[Steffl]

Hallo Michael,

mir ist doch noch was eingefallen. Teste mal

Code:

Private Sub CommandButton3_Click()
   Dim loS As Long
   Dim lngZeile As Long
   Dim arrSpielAuswahl
   Dim arrTreffer
   Dim blnAlle As Boolean
   Dim ctrElement As Control
   Dim Sum As String
   Dim rngTreffer As Range
   Dim strTreffer As String
   Dim rngBereich As Range

   arrSpielAuswahl = Array(3, 9, 15, 21, 27, 33)        ' 1. Spalte des jeweiligen Spiels
   arrTreffer = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 8)  ' Array für die Trefferauswertung
   If cbbSpiel <> "" Then
      ' Schleife über alle Steuerelemente
      For Each ctrElement In Me.Controls
         ' Stuerelement ist eine ComboBox
         If TypeName(ctrElement) = "ComboBox" Then
            ' ComboBox1 - ComboBox5
            Select Case ctrElement.Name
               Case "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5"
                  ' eine der ComboBoxen enthält keine Auswahl
                  If ctrElement = "" Then
                     ' Variable auf True setzen und Schleife verlassen
                     blnAlle = True
                     Exit For
                  End If
            End Select
         End If
      Next ctrElement
      ' alle ComboBoxen haben eine Auswahl
      If blnAlle = False Then
         lngZeile = Range(ComboBox8.RowSource).Cells(1).Row + ComboBox8.ListIndex
         'lngZeile = Range(arrNamen(ComboBox11.ListIndex)).Row + ComboBox8.ListIndex
         With Sheets("Beispiel")
             If ComboBox8.ListIndex > -1 Then
                  loS = arrSpielAuswahl(cbbSpiel.ListIndex)
                  If Application.CountA(.Range(.Cells(lngZeile, loS), .Cells(lngZeile, loS + 5))) > 5 Then
                      MsgBox "Dieser Teilnehmer hat schon 5 Würfe gespielt."
                      Exit Sub
                  Else
                     .Cells(lngZeile, loS) = arrTreffer(ComboBox1.ListIndex)        '1 Wurf vom Spiel
                     .Cells(lngZeile, loS + 1) = arrTreffer(ComboBox2.ListIndex)    '2 Wurf vom Spiel
                     .Cells(lngZeile, loS + 2) = arrTreffer(ComboBox3.ListIndex)    '3 Wurf vom Spiel
                     .Cells(lngZeile, loS + 3) = arrTreffer(ComboBox4.ListIndex)    '4 Wurf vom Spiel
                     .Cells(lngZeile, loS + 4) = arrTreffer(ComboBox5.ListIndex)    '5 Wurf vom Spiel
                     .Cells(lngZeile, loS + 5) = CDbl(TextBox3)                     'Gesamt vom Spiel
'                     Sum = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"    'Gesamt vom Siel aus Spalte 8, 14, 20, 26, 32 und 38
'                     .Cells(lngZeile, 39) = Sum
'                     Sum = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"    'Gesamt vom Siel aus Spalte 8, 14, 20, 26, 32 und 38
                     .Cells(lngZeile, 39).FormulaR1C1 = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"
                     'Suchen nach den Namen in den Spalten G und M der Tabelle Auswertung
                     Set rngTreffer = Worksheets("Auswertung").Range("G:G", "M:M").Find(ComboBox8.Value, LookIn:=xlValues, lookat:=xlWhole)
                     'wenn es einen Treffer gibt (sollte immer der Fall sein)
                     If Not rngTreffer Is Nothing Then
                        'merke die Adresse
                        strTreffer = rngTreffer.Address
                        Do
                           'und vergleiche noch den Vornamen und den Klubnamen
                           If rngTreffer.Offset(, 1) = ComboBox8.List(ComboBox8.ListIndex, 1) And rngTreffer.Offset(, 2) = ComboBox11.Value Then
                              'übernehme den Wert
                              rngTreffer.Offset(, 3) = Worksheets("Beispiel").Cells(lngZeile, 39).Value
                              'und lege den zu sortierenden Bereich fest
                              Set rngBereich = rngTreffer.CurrentRegion.Offset(1).Resize(rngTreffer.CurrentRegion.Rows.Count - 1)
                              'und sortiere den Bereich absteigend nach der Holzzahl
                              With rngBereich
                                 .Sort key1:=.Cells(1, 5), order1:=xlDescending, Header:=xlYes
                              End With
                              Exit Do
                           End If
                           Set rngTreffer = Worksheets("Auswertung").Range("G:G", "M:M").FindNext(rngTreffer)
                        Loop While rngTreffer.Address <> strTreffer
                     End If
                      If IsNumeric(TextBox4) Then .Cells(lngZeile, 40) = .Cells(lngZeile, 40) + CDbl(TextBox4)
                      If IsNumeric(TextBox5) Then .Cells(lngZeile, 41) = .Cells(lngZeile, 41) + CDbl(TextBox5)
                      If IsNumeric(TextBox6) Then .Cells(lngZeile, 42) = .Cells(lngZeile, 42) + CDbl(TextBox6)
                      If IsNumeric(TextBox8) Then .Cells(lngZeile, 43) = .Cells(lngZeile, 43) + CDbl(TextBox8)
                      UserForm_Initialize
                      Me.TextBox3 = ""
                      Me.TextBox4 = ""
                      Me.TextBox5 = ""
                      Me.TextBox6 = ""
                      Me.TextBox8 = ""
                  End If
             Else
                  MsgBox "Keinen Spieler ausgewählt"
             End If
         End With
      Else
         MsgBox "Bitte für alle Würfe einen Wert auswählen"
      End If
   Else
      MsgBox "Bitte ein Spiel auswählen"
   End If
End Sub

[michel34497]

Hallo Stefan!
Was soll ich sagen einfach :18: , was du da hin zauberst.
Ich werde jetzt, ersteimal noch mehrmals den Code Testen!

Ich :23: mich vor dir und kann nur sagen Danke, am liebsten würde ich jetzt gerne mit dir einen :15:.


Tausend Dank für die Hilfe!

[Steffl]

Hallo Michael,

....am liebsten würde ich jetzt gerne mit dir einen :15:.

das könnten wir hier beim Exceltreffen machen. Mußt nur noch buchen :05:

Informationen zum Hotel gibt es hier.

Gruß Stefan

[michel34497]

Hallo Stefan!

Wie ich schon einmal sagte, am anfang des beitrages sollen auch die Clubpunkte mit in die Tabelle Auswertung mit übertragen werden.
Um diese zu berechnen, habe ich wie du schon gesehen hast einen anderen Beitrag eingestellt. Nun möchte ich gerne diese Werte auch wie bei den Spielern bei den Clubnamen eintragen. Gesamtpunkte (Gesamtholz) und Durchschnitt (Holz, danach wird die Rangliste berechnet). Wie kann mann das wie bei den Spielern machen?
Ich hoffe du oder ein anderer kann mir helfen!
Vielen Dank für alle Vorschläge.

[Steffl]

Hallo Michael,

ich habe das Ganze wieder auf zwei Codes verteilt. In dem einen wird in der Tabelle Auswertung neben den Clubnamen zwei Formel eingetragen.

Code:

Private Sub CommandButton7_Click()
    Dim lngLetzte As Long
    Dim lngLetzteAuswert As Long
    If TextBox10 <> "" Then
        'Ist die Zelle B4 leer?
        With Worksheets("Beispiel")
            If .Cells(4, 2) = "" Then
                .Cells(4, 2) = TextBox10
                .Cells(5, 45) = 0    'Neu eingefügt zum Zählen der Spieler
            Else
                lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
                lngLetzte = lngLetzte + 2
                .Range("A4:AR5").Copy .Cells(lngLetzte, 1)
                .Cells(lngLetzte, 2) = TextBox10
                .Cells(lngLetzte, 45).Offset(1, 0) = 0      'Neu eingefügt zum Zählen der Spieler
                Application.CutCopyMode = False
            End If
        End With
        'es ist günstiger, die Tabelle Auswertung nach der zweiten If-Abfrage zu befüllen, da nur einmal der Code nötig ist
        With Worksheets("Auswertung")
            lngLetzteAuswert = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
            lngLetzteAuswert = lngLetzteAuswert + 1
            .Cells(lngLetzteAuswert, 2) = TextBox10
            'zwei Index-Formel werden mit eingefügt
            .Cells(lngLetzteAuswert, 3).Formula = "=INDEX(Beispiel!C[42],MATCH(RC[-1],Beispiel!C[-1],0)+2)"
            .Cells(lngLetzteAuswert, 4).Formula = "=INDEX(Beispiel!C[40],MATCH(RC[-2],Beispiel!C[-2],0)+2)"
        End With
    Else
        MsgBox "Kein neuer Club eingetragen!"
    End If
    ComboBoxenFuellen
End Sub

und im zweiten Code erfolgt nach der Sortierung der Spieler die Sortierung der Clubs.

Code:

Private Sub CommandButton3_Click()
   Dim loS As Long
   Dim lngZeile As Long
   Dim arrSpielAuswahl
   Dim arrTreffer
   Dim blnAlle As Boolean
   Dim ctrElement As Control
   Dim Sum As String
   Dim rngTreffer As Range
   Dim strTreffer As String
   Dim rngBereich As Range

   arrSpielAuswahl = Array(3, 9, 15, 21, 27, 33)        ' 1. Spalte des jeweiligen Spiels
   arrTreffer = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 8)  ' Array für die Trefferauswertung
   If cbbSpiel <> "" Then
      ' Schleife über alle Steuerelemente
      For Each ctrElement In Me.Controls
         ' Stuerelement ist eine ComboBox
         If TypeName(ctrElement) = "ComboBox" Then
            ' ComboBox1 - ComboBox5
            Select Case ctrElement.Name
               Case "ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5"
                  ' eine der ComboBoxen enthält keine Auswahl
                  If ctrElement = "" Then
                     ' Variable auf True setzen und Schleife verlassen
                     blnAlle = True
                     Exit For
                  End If
            End Select
         End If
      Next ctrElement
      ' alle ComboBoxen haben eine Auswahl
      If blnAlle = False Then
         lngZeile = Range(ComboBox8.RowSource).Cells(1).Row + ComboBox8.ListIndex
         'lngZeile = Range(arrNamen(ComboBox11.ListIndex)).Row + ComboBox8.ListIndex
         With Sheets("Beispiel")
             If ComboBox8.ListIndex > -1 Then
                  loS = arrSpielAuswahl(cbbSpiel.ListIndex)
                  If Application.CountA(.Range(.Cells(lngZeile, loS), .Cells(lngZeile, loS + 5))) > 5 Then
                      MsgBox "Dieser Teilnehmer hat schon 5 Würfe gespielt."
                      Exit Sub
                  Else
                     .Cells(lngZeile, loS) = arrTreffer(ComboBox1.ListIndex)        '1 Wurf vom Spiel
                     .Cells(lngZeile, loS + 1) = arrTreffer(ComboBox2.ListIndex)    '2 Wurf vom Spiel
                     .Cells(lngZeile, loS + 2) = arrTreffer(ComboBox3.ListIndex)    '3 Wurf vom Spiel
                     .Cells(lngZeile, loS + 3) = arrTreffer(ComboBox4.ListIndex)    '4 Wurf vom Spiel
                     .Cells(lngZeile, loS + 4) = arrTreffer(ComboBox5.ListIndex)    '5 Wurf vom Spiel
                     .Cells(lngZeile, loS + 5) = CDbl(TextBox3)                     'Gesamt vom Spiel
'                     Sum = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"    'Gesamt vom Siel aus Spalte 8, 14, 20, 26, 32 und 38
'                     .Cells(lngZeile, 39) = Sum
'                     Sum = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"    'Gesamt vom Siel aus Spalte 8, 14, 20, 26, 32 und 38
                     .Cells(lngZeile, 39).FormulaR1C1 = "=SUM(RC[-31],RC[-25],RC[-19],RC[-13],RC[-7],RC[-1])"
                     'Suchen nach den Namen in den Spalten G und M der Tabelle Auswertung
                     Set rngTreffer = Worksheets("Auswertung").Range("G:G", "M:M").Find(ComboBox8.Value, LookIn:=xlValues, lookat:=xlWhole)
                     'wenn es einen Treffer gibt (sollte immer der Fall sein)
                     If Not rngTreffer Is Nothing Then
                        'merke die Adresse
                        strTreffer = rngTreffer.Address
                        Do
                           'und vergleiche noch den Vornamen und den Klubnamen
                           If rngTreffer.Offset(, 1) = ComboBox8.List(ComboBox8.ListIndex, 1) And rngTreffer.Offset(, 2) = ComboBox11.Value Then
                              'übernehme den Wert
                              rngTreffer.Offset(, 3) = Worksheets("Beispiel").Cells(lngZeile, 39).Value
                              'und lege den zu sortierenden Bereich fest
                              Set rngBereich = rngTreffer.CurrentRegion.Offset(1).Resize(rngTreffer.CurrentRegion.Rows.Count - 1)
                              'und sortiere den Bereich absteigend nach der Holzzahl
                              With rngBereich
                                 .Sort key1:=.Cells(1, 5), order1:=xlDescending, Header:=xlYes
                              End With
                              'den Klubbreich bestimmen
                              With Worksheets("Auswertung")
                                 Set rngBereich = .Cells(5, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 4, 3)
                              End With
                              With rngBereich
                                 .Sort key1:=.Cells(1, 2), order1:=xlDescending, Header:=xlYes
                              End With
                              Exit Do
                           End If
                           Set rngTreffer = Worksheets("Auswertung").Range("G:G", "M:M").FindNext(rngTreffer)
                        Loop While rngTreffer.Address <> strTreffer
                     End If
                      If IsNumeric(TextBox4) Then .Cells(lngZeile, 40) = .Cells(lngZeile, 40) + CDbl(TextBox4)
                      If IsNumeric(TextBox5) Then .Cells(lngZeile, 41) = .Cells(lngZeile, 41) + CDbl(TextBox5)
                      If IsNumeric(TextBox6) Then .Cells(lngZeile, 42) = .Cells(lngZeile, 42) + CDbl(TextBox6)
                      If IsNumeric(TextBox8) Then .Cells(lngZeile, 43) = .Cells(lngZeile, 43) + CDbl(TextBox8)
                      UserForm_Initialize
                      Me.TextBox3 = ""
                      Me.TextBox4 = ""
                      Me.TextBox5 = ""
                      Me.TextBox6 = ""
                      Me.TextBox8 = ""
                  End If
             Else
                  MsgBox "Keinen Spieler ausgewählt"
             End If
         End With
      Else
         MsgBox "Bitte für alle Würfe einen Wert auswählen"
      End If
   Else
      MsgBox "Bitte ein Spiel auswählen"
   End If
End Sub

Gruß Stefan

PS: Ich würde mich freuen, wenn Du dich dazu entschließen könntest am Treffen teilzunehmen.

[michel34497]

Hallo Stefan!
Der erste Test war super! Werde aber noch weiter Testen.
:100:16:
Mir ist aber schon was aufgefallen was ich vergessen habe.
Melde mich aber erste nach den ausgiebigen Test


PS: So wie es aussieht werde ich wahrscheinlich für einen Tag ( Samstag ) zu euch Kommen. Habe den 19. Geburtstag und meine Tochter möchte gerne mit mir Feiern!