So, ich hab mich mal hingesetzt und 2-3 Zeilen zusammengezimmert:
Füge bitte über Ansicht > Symbolleisten > Steuerelement-Toolbox die CheckBoxen ein (die über die Formular-Symbolleisten sind mMn etwas umständlicher zu verwenden).
CheckBox1 habe ich die Caption(=Bezeichnung) „Schulter links“, CheckBox2 „Schulter rechts“ und CheckBox3 „lumbal links“ gegeben (kannst du natürlich anpassen wie du möchtest).
Zudem habe ich 2 Funktionen (addLokation und delLokation) eingefügt, die die jeweilige Lokation zum Zellwert hinzufügen bzw. den Zellwert daraufhin überprüfen und ggf. rauslöschen. So brauchst du in die Sub der jeweiligen Checkboxen immer nur den Quellcode reinzupasten und anzupassen, wie du ihn auch bei CB1, CB2 und CB3 siehst.
Quellcode:
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
addLokation (CheckBox1.Caption)
Else
delLokation (CheckBox1.Caption)
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
addLokation (CheckBox2.Caption)
Else
delLokation (CheckBox2.Caption)
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
addLokation (CheckBox3.Caption)
Else
delLokation (CheckBox3.Caption)
End If
End Sub
Private Sub addLokation(lokation As String)
If Range(„A1“).Value > „“ Then
Range(„A1“).Value = Range(„A1“).Value & ", " & lokation
Else
Range(„A1“).Value = lokation
End If
End Sub
Private Sub delLokation(lokation As String)
Dim iPos As Integer
Dim strValue As String
Dim strOutput As String
strValue = Range(„A1“).Value
strOutput = „“
iPos = InStr(strValue, „,“)
If iPos > 0 Then ’ Komma gefunden => mehr als 1 Lokation angegeben
arrLokationen = Split(strValue, ", ") 'aufsplitten der Werte
For i = 0 To UBound(arrLokationen)
'Jede Lokation mit der zu löschenden prüfen
If arrLokationen(i) lokation Then
'Wenn die Lokation ungleich der zu löschenden ist, wird
'sie in den Ausgabestring übernommen.
'Der if-else-Zweig dient nur dazu, an der richtigen Position
'mit dem Komma zu beginnen.
If strOutput = „“ Then
strOutput = arrLokationen(i)
Else
strOutput = strOutput & ", " & arrLokationen(i)
End If
End If
Next i
'Lokationen wieder in die Zelle schreiben
Range(„A1“).Value = strOutput
Else 'Nur 1 oder kein Eintrag vorhanden
If strValue > „“ And strValue = lokation Then
'Nur wenn die Zelle nicht leer ist und der Wert
'der Lokation entspricht, wird gelöscht
Range(„A1“).Value = „“
End If
End If
End Sub
Solltest du noch Fragen dazu haben, lass es mich wissen.
Gruß Stefi
