Office: (Office 2016) VBA: Wenn Zelle X einen bestimmten Wert hat, soll in Zelle Y etwas eingetragen werden

Servus zusammen,

Zunächst mal: Freut mich unter Euren Reihen zu sein ;-)

Nun zum Problem.
Ich möchte über ein Makro eine Funktion bauen, die wie folgt aufgebaut ist:
Spalte A hat nur ein Merkmal in sechs Ausprägungen; als Freitextfeld oder über DropDown (Datenüberprüfung)
Wenn 3 bestimmte Ausprägungen in der Zelle stehen, über DropDown oder Freitext, soll in der Zelle daneben ein "-" (ein Minus) erscheinen.

Leider macht mich das Ganze langsam verrückt...

Private Sub Worksheet_Doc_No(ByVal Target As Range)
If Intersect(Target, Range("A1:A1000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "Email" Or "Besuch" Or "Anruf" Then
Target.Offset(0, 1) = "-"
Else:
Target.Offset(0, 1).ClearContents
End If
End Sub

Kann mir einer hierbei vielleicht helfen?

Schönen Gruß,
Papst im Ruhestand, der III

 

Hallo PapaEmeritus3,

musst Du deine Audienzen protokollieren??

Wo genau ist dein Problem?
Spontan sehe ich neben dem "Else" einen Doppelpunkt, der da nicht hingehört.
Dann geht "If Target.Value = "Email" Or "Besuch" Or "Anruf" Then" nicht, sondern "If Target.Value = "Email" Or Target.Value = "Besuch" Or Target.Value = "Anruf" Then".
Außerdem übergibst Du beim Start des Makro einen Zellbezug. Aber wo kommt der her? Startest Du das Makro durch ein anderes oder sollte es eigentlich ein Event sein?

Hab da mal was gebastelt:

HTML:

Private Sub Worksheet_Doc_No()

Dim Zeile As Integer

For Zeile = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(Zeile, 1) = "Email" Or Cells(Zeile, 1) = "Besuch" Or Cells(Zeile, 1) = "Anruf" Then
    Cells(Zeile, 2) = "-"
    Else
    Cells(Zeile, 2).ClearContents
    End If
Next Zeile

End Sub

Gruß,
Lutz

 

Hi Lutz,

vielen Dank!
Protokollieren, nicht - die Datei hat einen anderen Hintergrund ;-)

Das Makro soll eigentlich "permanent" laufen, also sobald ein Zelleneintrag vorgenommen ist, soll die Nachbarzelle befüllt werden.

 

Hallo PapaEmeritus3,

na dann ist es ja fast noch viel einfacher:

HTML:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "Email" Or Target.Value = "Besuch" Or Target.Value = "Anruf" Then
Target.Offset(0, 1) = "-"
Else
Target.Offset(0, 1).ClearContents
End If

End Sub

Das Makro gehört in dein VBA-Projekt in das Blatt, in dem es arbeiten soll.
Der Name "Private Sub Worksheet_Change(ByVal Target As Range)" ist wichtig und darf nicht geändert werden, da es sich um ein Event handelt. Also jedes mal, wenn du eine Zelle in dem Blatt änderst, läuft das Makro und prüft die gerade geänderte Zelle (Target).

Gruß,
Lutz

 

Und wenn ich bereits ein Makro hab, welches mit Private Sub Worksheet_Change(ByVal Target As Range) beginnt?
Fehler "Mehrdeutiger Name"...

Hast Du auch hier Aushilfe?

 

Dann musst Du beide zusammenschmeißen und, falls es sich um verschiedene zu bearbeitende Bereiche handelt, über eine If-Abfrage unterscheiden.

Du kannst ja einfach mal beide Makros posten und dann schmeißen wir die zusammen.

Gruß,
Lutz

 

Gerne ;-)


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D1:D1000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then
Target.Offset(0, 1).ClearContents
Else:
Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "Email" Or Target.Value = "Besuch" Or Target.Value = "Anruf" Then
Target.Offset(0, 1) = "-"
Else
Target.Offset(0, 1).ClearContents
End If

End Sub

 

HTML:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 4 Then
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
    Else
        Target.Offset(0, 1) = CDate(Format(Now, "dd.mm.yyyy"))
    End If
ElseIf Target.Column = 1 Then
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "Email" Or Target.Value = "Besuch" Or Target.Value = "Anruf" Then
        Target.Offset(0, 1) = "-"
    Else
        Target.Offset(0, 1).ClearContents
    End If
End If

End Sub

 

You, Sir, are the best! :-D
Danke!!!!!!!!

 

Keine Ursache ;-)