Excel mit VBA ListBox2 in Abhängigkeit von ListBox1 befüllen

[sveni_lee]

ja, das war's...

und einmal hatte cih noch LisBox statt ListBox geschrieben...

Jetzt klappt es danke  .


Kann ich unter dem Eingabewert Jahr, KW und Wochentag den heute aktuellen Wert vorgeben lassen?

[Steffl]

Hallo,

vielleicht so

Code:

Private Sub UserForm_Initialize()

Dim i As Integer
Dim j As Integer

For k = 1 To ThisWorkbook.Worksheets("Tabelle1").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    ListBox_Muskelgruppe.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(1, k)
Next

'KW

With ComboBox_KW
    For i = 1 To 52
        .AddItem CInt(i)
        .Value = DatePart("ww", Date, vbMonday, vbFirstFourDays) 'von Nepumuk
    Next
End With
        'DatePart("ww", dein-datum , vbMonday, vbFirstFourDays)'
'Me.

'Wochentag
With ListBox_Wochentag
    .AddItem "Montag"
    .AddItem "Dienstag"
    .AddItem "Mittwoch"
    .AddItem "Donnerstag"
    .AddItem "Freitag"
    .AddItem "Samstag"
    .AddItem "Sonntag"
    .ListIndex = (DatePart("w", Date, vbMonday, vbFirstFourDays) - 1)
End With

'Training
With ListBox_Training
    .AddItem "Muskelaufbau"
    .AddItem "Cardio"
End With

'Muskelgruppe
'With ListBox_Muskelgruppe
'    .AddItem "Arme"
'    .AddItem "Bauch"
'    .AddItem "Beine"
'    .AddItem "Brust"
'    .AddItem "R?cken"
'    .AddItem "Schulter"
'End With

'?bung

'With ListBox_Uebung
'    .AddItem "Abduktionsmaschine"
'    .AddItem "Adduktionmaschine"
'    .AddItem "Bauchbank"
'    .AddItem "Bauchpresse"
'    .AddItem "Beinbeuger"
'    .AddItem "Beinpresse"
'    .AddItem "Bizepsmaschiene"
'    .AddItem "Brustmaschiene"
'    .AddItem "Butterfly"
'    .AddItem "Butterfly reverse"
'    .AddItem "DIP-Maschiene"
'    .AddItem "Latzugmaschiene"
'    .AddItem "Medizinball/Crunches"
'    .AddItem "Popresse"
'    .AddItem "R?ckenstrecker"
'    .AddItem "Ruderzugmaschiene"
'    .AddItem "Seithebemaschiene"
'    .AddItem "Trizepsmaschiene"
'    .AddItem "Twistermaschiene"
'    .AddItem "Wadenmaschiene"
'End With

'Satz

'Gewicht
SpinButton_Gewicht.Min = 20
SpinButton_Gewicht.Value = 20
TextBox_Gewicht.Text = SpinButton_Gewicht.Value

'Wiederholung
SpinButton_Wdhlg.Min = 1
SpinButton_Wdhlg.Value = 1
TextBox_Wdhlg.Text = SpinButton_Wdhlg.Value


'Intervall

'Strecke

'Zeit
SpinButton_Zeit.Min = 20
SpinButton_Zeit.Value = 20
TextBox_Zeit.Text = SpinButton_Zeit.Value

'Jahr

With ComboBox_Jahr
    For j = 2019 To 2025
        .AddItem CInt(j)  '??? Warum hier die Umwandlungsfunktion?
    Next
    .Value = Year(Date)
End With


End Sub

PS: Es gibt Jahre mit 53 Kalenderwochen

[sveni_lee]

Klappt super...

und wie das immer so ist, wenn man dabei ist kommen einem neue Ideen.
Ich lasse das Datum aus Jahr, KW und Wochentag in der Exceltabelle errechnen.
Nun würde ich das auch gern in VBA machen und dann direct übergeben.

Ich habe folgendes probiert:

Code:

Private Sub Button_Eingabe_Click()

'Erste freie Zeile ausfindig machen
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

'KW
Cells(last, 1).Value = ComboBox_KW

'Wochentag
Cells(last, 2).Value = ListBox_Wochentag

'Training
Cells(last, 4).Value = ListBox_Training

'Muskelgruppe
Cells(last, 5).Value = ListBox_Muskelgruppe

'Übung
Cells(last, 6).Value = ListBox_Uebung

'Satz
If OptionButton_Satz1.Value = True Then Cells(last, 7).Value = "Satz 1"
If OptionButton_Satz2.Value = True Then Cells(last, 7).Value = "Satz 2"
If OptionButton_Satz3.Value = True Then Cells(last, 7).Value = "Satz 3"
If OptionButton_Satz4.Value = True Then Cells(last, 7).Value = "Satz 4"

'Gewicht
If ListBox_Training = "Cardio" Then Cells(last, 8).Value = ""
If ListBox_Training = "Muskelaufbau" Then Cells(last, 8).Value = TextBox_Gewicht

'Wiederholung
If ListBox_Training = "Cardio" Then Cells(last, 9).Value = ""
If ListBox_Training = "Muskelaufbau" Then Cells(last, 9).Value = TextBox_Wdhlg

'Intervall
If OptionButton_Interv1.Value = True Then Cells(last, 10).Value = "Intervall 1"
If OptionButton_Interv2.Value = True Then Cells(last, 10).Value = "Intervall 2"
If OptionButton_Interv3.Value = True Then Cells(last, 10).Value = "Intervall 3"
If OptionButton_Interv4.Value = True Then Cells(last, 10).Value = "Intervall 4"
If OptionButton_Interv5.Value = True Then Cells(last, 10).Value = "Intervall 5"
If OptionButton_Interv6.Value = True Then Cells(last, 10).Value = "Intervall 6"

'Strecke
Cells(last, 11).Value = TextBox_Strecke

'Zeit
If ListBox_Training = "Cardio" Then Cells(last, 12).Value = TextBox_Zeit
If ListBox_Training = "Muskelaufbau" Then Cells(last, 12).Value = ""

'Jahr
Cells(last, 13).Value = ComboBox_Jahr

'Datum Brechnung
Cells(last, 3).Value = DATUM((ComboBox_Jahr);1;7*(ComboBox_KW)+4-WOCHENTAG(DATUM((ComboBox_Jahr);;);3)-SUCHEN(LINKS((ListBox_Wochentag);2);"-SoSaFrDoMiDiMo")/2)

End Sub

Aber zu glauben, das man formeln für Excel einfach so übergeben kann, war wohl zu blauäugig...

[Steffl]

Hallo,

wenn Du es als Formel eintragen willst, kannst Du es mal so versuchen, wobei ich mir nicht sicher bin, ob die Anführungszeichen richtig eingetragen werden.

Code:

'Datum Brechnung
Cells(last, 3).FormulaLocal = "=DATUM((" & ComboBox_Jahr & ");1;7*(" & ComboBox_KW & ")+4-WOCHENTAG(DATUM((" & ComboBox_Jahr & ");;);3)-SUCHEN(LINKS((" & ListBox_Wochentag & ");2);""-SoSaFrDoMiDiMo"")/2)"

[sveni_lee]

hmm, also es werden die richtigen werte eingesetzt aber bei der Berechnung steht dann (siehe Anhang)

[Steffl]

Hallo,

Code:

'Datum Brechnung
Cells(last, 3).FormulaLocal = "=DATUM((" & ComboBox_Jahr & ");1;7*(" & ComboBox_KW & ")+4-WOCHENTAG(DATUM((" & ComboBox_Jahr & ");;);3)-SUCHEN(LINKS((""" & ListBox_Wochentag & """);2);""-SoSaFrDoMiDiMo"")/2)"

[sveni_lee]

Perfekt... läuft super.

Vielen Dank

[Steffl]

Hallo,

Perfekt... läuft super.

Nö, wenn Du die Userform startest, den ausgewählten Wochentag nicht änderst und auf Eingabe klickst, werden die Daten falsch übertragen.

[sveni_lee]

ja schon aber wie soll ich das ändern?
Ich muß ja auch die Möglichkeit haben Trainiingsergebnisse nachzutragen.
Oder versehe ich da gra was falsch?

[Steffl]

Hallo,

ob die Formel wirklich so paßt, weiß ich nicht zumindest ist von mir angesprochene Fehler weg. Außerdem habe ich in zwei Fällen dafür gesorgt, dass Zahlen auch tatsächlich als Zahlen eingetragen werden.

Code:

Private Sub Button_Eingabe_Click()

'Erste freie Zeile ausfindig machen
Dim last As Integer
Dim intZaehler As Integer

last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

'KW
Cells(last, 1).Value = CInt(ComboBox_KW)

'Wochentag
Cells(last, 2).Value = ListBox_Wochentag.List(ListBox_Wochentag.ListIndex)

'Training
Cells(last, 4).Value = ListBox_Training

'Muskelgruppe
Cells(last, 5).Value = ListBox_Muskelgruppe

'?bung
Cells(last, 6).Value = ListBox_Uebung

'Satz
If OptionButton_Satz1.Value = True Then Cells(last, 7).Value = "Satz 1"
If OptionButton_Satz2.Value = True Then Cells(last, 7).Value = "Satz 2"
If OptionButton_Satz3.Value = True Then Cells(last, 7).Value = "Satz 3"
If OptionButton_Satz4.Value = True Then Cells(last, 7).Value = "Satz 4"

'Gewicht
If ListBox_Training = "Cardio" Then Cells(last, 8).Value = ""
If ListBox_Training = "Muskelaufbau" Then Cells(last, 8).Value = TextBox_Gewicht

'Wiederholung
If ListBox_Training = "Cardio" Then Cells(last, 9).Value = ""
If ListBox_Training = "Muskelaufbau" Then Cells(last, 9).Value = TextBox_Wdhlg

'Intervall
For intZaehler = 1 To 6
   If Controls("OptionButton_Interv" & intZaehler) Then Cells(last, 10).Value = "Intervall " & intZaehler: Exit For
Next intZaehler
'If OptionButton_Interv1.Value = True Then Cells(last, 10).Value = "Intervall 1"
'If OptionButton_Interv2.Value = True Then Cells(last, 10).Value = "Intervall 2"
'If OptionButton_Interv3.Value = True Then Cells(last, 10).Value = "Intervall 3"
'If OptionButton_Interv4.Value = True Then Cells(last, 10).Value = "Intervall 4"
'If OptionButton_Interv5.Value = True Then Cells(last, 10).Value = "Intervall 5"
'If OptionButton_Interv6.Value = True Then Cells(last, 10).Value = "Intervall 6"

'Strecke
Cells(last, 11).Value = TextBox_Strecke

'Zeit
If ListBox_Training = "Cardio" Then Cells(last, 12).Value = TextBox_Zeit
If ListBox_Training = "Muskelaufbau" Then Cells(last, 12).Value = ""

'Jahr
Cells(last, 13).Value = CInt(ComboBox_Jahr)
'Datum Brechnung
Cells(last, 3).FormulaLocal = "=DATUM((" & ComboBox_Jahr & ");1;7*(" & ComboBox_KW & ")+4-WOCHENTAG(DATUM((" & ComboBox_Jahr & ");;);3)-SUCHEN(LINKS((""" & ListBox_Wochentag.List(ListBox_Wochentag.ListIndex) & """);2);""-SoSaFrDoMiDiMo"")/2)"
End Sub