AW: Text dauerhaft Übernehmen
08.01.2021 15:50:01
Nepumuk
Hallo,
Rechtklick auf den Tabellenreiter "Permanent input". Code einfügen, folgende Prozedur einfügen:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const LIST_SEPARATOR As String = ", "
Dim objCell As Range
If Target.Address = "$S$7" Then
Set objCell = Columns(3).Find(What:=Cells(2, 15).Text, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not objCell Is Nothing Then
Application.EnableEvents = False
If objCell.Offset(0, 2).Value = "NE" Then objCell.Offset(0, 2).Value = Empty
If Not IsEmpty(objCell.Offset(0, 2).Value) Then
objCell.Offset(0, 2).Value = objCell.Offset(0, 2).Value & LIST_SEPARATOR & Target.Text
Else
objCell.Offset(0, 2).Value = Target.Text
End If
Set objCell = Nothing
Application.EnableEvents = True
Else
Call MsgBox("Input-Cell " & Cells(2, 15).Text & " nich gefunden.", vbExclamation, "Hinweis")
End If
End If
End Sub
Die Formeln in Spalte E löschst du am besten, dazu den Bereich markieren - Strg+c - Rechtsklick - Inhalte einfügen - Werte.
GrußNepumuk