Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Code optimieren und zusätze einfügen
#11
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:
mfg
Michael
:98:

WIN 10  Office 2019
Antworten Top
#12
Hallo Michael,

was soll da sonst stehen? Und was hast Du gegen RC?
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#13
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!


Angehängte Dateien
.xlsm   RE_Michael_42.xlsm (Größe: 94,23 KB / Downloads: 5)
mfg
Michael
:98:

WIN 10  Office 2019
Antworten Top
#14
Sad 
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
Antworten Top
#15
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
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • michel34497
Antworten Top
#16
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!
mfg
Michael
:98:

WIN 10  Office 2019
Antworten Top
#17
Hallo Michael,

(10.06.2014, 17:03)michel34497 schrieb: ....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
Antworten Top
#18
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? Huh
Ich hoffe du oder ein anderer kann mir helfen!
Vielen Dank für alle Vorschläge.


Angehängte Dateien
.xlsm   RE_Michael_42.xlsm (Größe: 101,5 KB / Downloads: 6)
mfg
Michael
:98:

WIN 10  Office 2019
Antworten Top
#19
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.
Antworten Top
#20
Hallo Stefan!
Der erste Test war super! Werde aber noch weiter Testen.
:10018: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!
mfg
Michael
:98:

WIN 10  Office 2019
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste