VBA, Eingabe überprüfen
#1
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
Top
#2
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
Top
#3
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
Top
#4
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
Top
#5
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
Top
#6
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
Top
#7
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
Top
#8
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
Top
#9
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. Huh

Nochmals vielen Dank.

Gruß Wolfgang
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste