Registriert seit: 25.01.2015
Version(en): 2016
Hallo
Wenn in C18 steht ein "x" steht und ich gebe in F18 ein "x" ein dann soll der Inhalt C18 gelöscht werden, oder umgekehrt, F18 "x" und C18 leer.
Das möchte ich mit VBA machen, aber wie?
Gruß Wolfgang Virnich
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo wolfagang, z.B. mit folgendem Code hinter der Tabelle: Code: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C18, F18")) Is Nothing Then If Target.Column = 3 Then If Target = LCase("x") Then Application.EnableEvents = False Range("F18").ClearContents Application.EnableEvents = True End If Else If Target = LCase("x") Then Application.EnableEvents = False Range("C18").ClearContents Application.EnableEvents = True End If End If End If End Sub
Gruß Atilla
Registriert seit: 25.01.2015
Version(en): 2016
Hallo Atilla
Herzlichen dank für deine Hilfe Super so geht es, das kann ich so einsetzten.
Ich habe aber noch 5 Zellen wo nur eine Zelle ausgefüllt sein darf, kann das auch in den Code mit eingebracht werden?
C11, F11, C12, F12, C13
Gruß Wolfgang
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Wolfgan, dann mit Offset so: Code: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C11,C12,C13,C18,F11,F12,F13, F18")) Is Nothing Then If Target.Column = 3 Then If Target.Text = LCase("x") Then Application.EnableEvents = False Target.Offset(0, 3).ClearContents Application.EnableEvents = True End If Else If Target.Text = LCase("x") Then Application.EnableEvents = False Target.Offset(0, -3).ClearContents Application.EnableEvents = True End If End If End If End Sub
Gruß Atilla
Registriert seit: 25.01.2015
Version(en): 2016
Hallo Atilla
Nochmals vielen Dank für deine Hilfe Den ersten Code habe ich so übernommen.
Das Prinzip habe ich verstanden, aber.....
Es sollen außerdem die 5 Zellen untereinander gepüft werden Range("C11,C12,C13,F11,F12"))
Wenn in C11 etwas steht dann die anderen Zellen leer wenn in C12 etwas steht dann die anderen Zellen leer usw.
Gruß Wolfgang
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Wolfgang, so vielleicht: Private Sub Worksheet_Change(ByVal Target As Range) Dim rngZellen As Range, varZelle As Variant Set rngZellen = Range("C11,C12,C13,C18,F11,F12,F13,F18") If Not Application.Intersect(Target, rngZellen) Is Nothing Then If Len(Target) Then On Error Resume Next Application.EnableEvents = False varZelle = Target.Value rngZellen = "" Target.Value = varZelle On Error GoTo 0 Application.EnableEvents = True End If End If End Sub Gruß Uwe
Registriert seit: 25.01.2015
Version(en): 2016
Hallo Uwe
Vielen Herzlichen Dank für deine Mühe.
So klappt es Super.
Morgen früh kann ich leider erst weitermachen.
Viele liebe Grüße und nochmals vielen Dank. Gruß Wolfgang
Registriert seit: 14.04.2014
Version(en): 2003, 2007
Hallo Wolfgang, mit dem Eintragen von "x" in eine Zelle hat da aber jetzt nichts mehr zu tun. Wenn ich Deine letzten Erläuterungen als Zusatz zu Deiner ersten Anfrage verstehe, dann würde ich es so lösen: Code: Private Sub Worksheet_Change(ByVal Target As Range) Dim varWert On Error GoTo ende Application.EnableEvents = False If Not Intersect(Target, Range("C18,F18")) Is Nothing Then If Target.Column = 3 Then If Target.Text = LCase("x") Then Target.Offset(0, 3).ClearContents End If Else If Target.Text = LCase("x") Then Target.Offset(0, -3).ClearContents End If End If ElseIf Not Intersect(Target, Range("C11,C12,C13,F11,F12")) Is Nothing Then If Target.Text <> "" Then varWert = Target.Text Range("C11,C12,C13,F11,F12").ClearContents Target.Value = varWert End If End If ende: Application.EnableEvents = True If Err Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description End Sub
Kann aber auch sein, dass Uwe es richtig gesehen hat. Dann gehe ich davon aus, dass Deine anfängliche Frage Dir nur einen Code liefern sollte, den Du selber weiter entwickeln wolltest.
Gruß Atilla
Registriert seit: 25.01.2015
Version(en): 2016
Hallo Atilla Vielen Herzlichen Dank für Deine Hilfe. Du hast wohl Recht, ich wollte erst eine Sache und dann kam mir noch eine ganz ander Idee. Nochmals vielen Dank. Gruß Wolfgang
|