Office: Dropdown Felder nur für Auswahl

Hallo,

ich habe in verschiedenen Zellen dropdown Möglichkeit.
zB: A1: Auswahl "ja" und "nein"
A2: Auswahl nur "ja"
Wie kann ich verhindern, dass "nein" aus Zelle A1 auf A2 geschrieben / kopiert werden kann?

VG
Foerbsen

 

schütze die Tabbele, Zellen geschützt.

 

Hallo Hajo

ja hab ich auch gedacht, aber dann kann man nichts eintragen ... also weder ja / nein

 

das habe ich dann wohl zu einfach gesehen.
Falls Du nur Nein verhindern willst?

starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.
Das Makro wird automatisch gestartet.
Der Code wirkt nur in dieser Tabelle.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        If Target <> UCase("ja") Then Target = ""
    End If
End Sub

Gruß Hajo

 

Moin!
@Hajo_Zi:
"Eigentlich" ist Dein Code ein typisches Beispiel für einen stack overflow.
Es scheint so, dass VBA da mittlerweile gnädiger gestimmt ist.
Ändert aber nichts daran, dass die Endlosschleife [erst/schon] nach 46 Durchläufen (wovon 45 unnötig sind) aussteigt.
Teste mal und berichte, was als letzte Zahl im Direktbereich steht.

Code:

Option Explicit
Dim i&
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        If Target <> UCase("ja") Then Target = ""
    End If
    i = i + 1
    Debug.Print i
End Sub

Gruß Ralf

 

das hatte in der schnelle übersehen.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False    ' Reaktion Eingabe
    If Target.Address = "$A$2" Then
        If Target <> UCase("ja") Then Target = ""
    End If
    Application.EnableEvents = True    ' Reaktion Eingabe
End Sub

Gruß Hajo

 

Hallo
vielen Dank! das klingt nach einer Lösung.
ich habe den letzten code verwendet:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' Reaktion Eingabe
If Target.Address = "$A$2" Then
If Target <> UCase("ja") Then Target = ""
End If
Application.EnableEvents = True ' Reaktion Eingabe
End Sub

Problem 1 ich kann in A2 kein Ja reinschreiben - es wird alles verhindert.
Problem 2: wenn ich in B2 bspw nein schreibe und es per Rahmen ziehen in c2 kopiere und danach wieder mit Rahmen in a2 ziehe steht nein in A2-C2 drin ...

ich hoffe es ist verständlich ...
Viele Grüße
Foerbsen

 

ich habe mir nochmal den ersten Beitrag angesehen

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False    ' Reaktion Eingabe
    If Target.Address = "$A$1" Then
        If UCase(Target) = "NEIN" Then
            Target.Offset(1, 0) = Target
            Target = ""
        End If
    End If
    Application.EnableEvents = True    ' Reaktion Eingabe
End Sub

Gruß Hajo

 

Problem 1 ist gelöst,
Das Makro bezieht sich jetzt auf A1 richtig?
Was muss ich tun dass es auf A1-A16 wirkt?

Problem 2 ist weiterhin da: ich kann immer noch nein "drüberziehen"
edit: aus A2 kann ich es nicht "drüberziehen" aber aus entfernteren schon also von A4 zB ... dann steht nein in A1-4

 

die Aufgabe ist mir nicht klar.
Bei A1 =Nein soll es in A2 geschrieben werden.
Jetzt ist A2 glei Nein, nach deinen Aufgabe A2 =Nein soll es in A3 geschrieben werden usw.
Warum nicht von A1 gleich in A17?

Ich bin dann raus.
Für ziehen habe ich keine Aufgabe

Gruß Hajo

 

Hallo Foerbsen,

probier' mal meinen Vorschlag. Vielleicht kommt dies deinem Wunsch nahe.

Gruß Sigi

 

Hallo,

ohne mir jetzt die einzelnen Vorschläge angesehen zu haben: warum löst du das nicht mit der Datenüberprüfung?

 

Hi,

@Klaus-Dieter: beim Ziehen hilft das nicht, da damit auch gleich die Datenüberprüfung mit überschrieben wird.

Die einfachste Methode wäre es das Ziehen generell zu verbieten:

Code:

Application.CellDragAndDrop = False

Oder der entsprechende Menu-Punkt in den Optionen.

Per VBA geht auch das:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Bereich2 As Range
Dim Zelle As Range
Set Bereich = Range("A1")
Set Bereich2 = Range("A2:A16")
Set Bereich = Intersect(Target, Bereich)
Set Bereich2 = Intersect(Target, Bereich2)
If Not Bereich Is Nothing Then
    Application.EnableEvents = False
    For Each Zelle In Bereich
        If Not (LCase(Zelle) = "ja" Or LCase(Zelle) = "nein") Then
            Zelle = ""
        End If
    Next Zelle
    Application.EnableEvents = True
End If
If Not Bereich2 Is Nothing Then
    Application.EnableEvents = False
    For Each Zelle In Bereich2
        If Not LCase(Zelle) = "ja" Then
            Zelle = ""
        End If
    Next Zelle
    Application.EnableEvents = True
End If
End Sub