Dropdown Mehrfachauswahl o. Wiederholung

Private Sub Worksheet_Change(ByVal Target As Range) Dim Oldvalue As String Dim Newvalue As String On Error GoTo Exitsub If Target.Column = 20 Then If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then GoTo Exitsub Else: If Target.Value = "" Then GoTo Exitsub Else Application.EnableEvents = False Newvalue = Target.Value Application.Undo Oldvalue = Target.Value If Oldvalue = "" Then Target.Value = Newvalue Else Target.Value = Oldvalue & " | " & Newvalue End If End If End If Application.EnableEvents = True Exitsub: Application.EnableEvents = True End Sub Eine weitere Frage wäre noch, ob die Funktion und der VBA Code übernommen wird und aktiv ist, wenn die Excel online zum Teilen zur Verfügung gestellt wird (damit mehrere Nutzer gleichzeitig darauf zugreifen können wie beispielsweise in MS Teams)? Danke für Eure Hilfe :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Target.Value = Newvalue If Oldalue "" Then If Newvalue "" Then If Right(Oldvalue, Len(Newvalue)) = Newvalue Then MsgBox "nicht möglich", vbCritical Application.EnableEvents = True Target.Value = Oldvalue Exit Sub End If End If End If

Hi,
ich schicke dir mal das komplette Makro:


'einfügen in dem Blatt, auf dem die Box ist
Private Sub Worksheet_Change(ByVal Target As Range)
'Es wird aus einer Dropdown-Liste eine Mehrfachauswahl zugelassen
'Zu Beginn steht etwas in der Zelle, dieser Eintrag wird gelöscht und
'durch die Auswahl aus der Liste ersetzt.
'Eine doppelte Auswahl ist nicht möglich.
Worksheets("Tabelle1").Unprotect Password:="test"          'Passwort anpassen!
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
Application.ScreenUpdating = False                  'Bildschirmaktualisierung ausschalten
Application.EnableEvents = True                     'Ereignisse einschalten (BeforePrint, BeforeSave, BeforeClose, usw.)
If Not Application.Intersect(Target, Range("D3")) Is Nothing Then       'Zelle anpassen
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False                    'Ereignisse ausschalten (BeforePrint, BeforeSave, BeforeClose, usw.)
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold  "" Then
If wertnew  "" Then
If Right(wertold, Len(wertnew)) = wertnew Then
MsgBox "nicht möglich", vbCritical
Application.EnableEvents = True                     'Ereignisse einschalten (BeforePrint, BeforeSave, BeforeClose, usw.)
Target.Value = wertold
Exit Sub
End If
If wertold  wertnew Then Target.Value = wertold & "; " & wertnew      'Werte durch Semikolon trennen, evtl. anpassen
End If
End If
End If
Application.EnableEvents = True                     'Ereignisse einschalten (BeforePrint, BeforeSave, BeforeClose, usw.)
End If
Application.EnableEvents = True                     'Ereignisse einschalten (BeforePrint, BeforeSave, BeforeClose, usw.)
Application.ScreenUpdating = True                   'Bildschirmaktualisierung einschalten
Worksheets("Tabelle1").Protect Password:="test"            'Passwort anpassen!
End Sub

Vielleicht hilft dir das besser.
Wenn du es auf jedem Tabellenblatt machen willst, dann musst du die oberste Zeile (worksheet_change) z. B. ändern zu


Private Sub Workbook_Activate

Dann beim "Dimensionierungsblock" noch zusätzlich:
Dim ws as Worksheet
Und um den eigentlichen Code herum eine For each-Schleife (For each ws in ThisWorkbook ... Makro ... Next ws).
Das allerdings ungetestet!
Gruß

Beliebteste Forumthreads (12 Monate)

Dropdown Mehrfachauswahl o. Wiederholung

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

224 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dropdown Mehrfachauswahl o. Wiederholung

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

224 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread