hi chris

wie gewuenscht

gruss nighty

einzufuegen
alt+f11/projektexplorer/DeineTabelle

die betroffenen zellen duerften im code leicht zu sehen sein,dadurch leicht zu erweitern geht

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
Dim rgBereich As Range
Dim zaehler As Range
Set rgBereich = Worksheets("Tabelle1").Range("A2,B2,C2,M2")
 For Each zaehler In rgBereich
  If zaehler = "" Then
    zaehler.Select
    Exit For
  End If
 Next zaehler
Application.EnableEvents = True
End Sub

Hallo nighty,

vielen Dank für deine Antwort.
Habe es grade mal getestet. Funktioniert zum Teil...
Bei deinem Code ist es so, dass immer in die gewählten Zellen ein Eintrag gemacht werden muss.
Ich hätte es gerne so:

Wenn Eingabe in A1, dann zwingende Eingabe in B1 und C1 erforderlich.

Wenn Eingabe in D3, dann zwingende Eingabe in E3 und F3 erforderlich.

Es sind immer die 2 Zellen rechts der frei ausfüllbaren Zelle, die nach Eingabe in die "frei ausfüllbare Zelle" ausgefüllt werden müssen, z.B. A1: B1+C1, F3: G3+H3, O54: P54+Q54

Da diese "Gültigkeiten" in der Tabelle an vielen verschiedenen Stellen vorkommen , würde ich gerne einen Code nutzen, auf den ich immer wieder verweisen kann.

Gibt es da irgendwie eine Möglichkeit?

Gruß
Chris

hi chris

vielleicht so :-)

gruss nighty

zur zeit drei bereiche a 3 zellen

ausloeser ist jeweils die erste zelle eines bereiches,ansonsten freie eingabe

einzufuegen
alt+f11/Projektexplorer/AllgemeinesModul

Public Wert(2) As Boolean

Function StrBe(Zellen As Variant, zaehler1 As Variant) As Variant
    Dim Zelle As String
    Dim zeich1 As Integer
    Dim schalter As Boolean
    Dim zaehler3 As Integer
    ReDim zaehler2(Len([Zellen])) As String
    zaehler3 = 1
    Application.Volatile
    If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
    For zeich1 = 1 To Len([Zellen])
        If Mid([Zellen], zeich1, 1) Like "[A-Z0-9]" = True Then
            zaehler2(zaehler3) = zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
            schalter = True
        End If
        If schalter = True And Mid([Zellen], zeich1, 1) Like "[A-Z0-9]" = False Then
            zaehler3 = zaehler3 + 1
            schalter = False
        End If
    Next zeich1
    StrBe = zaehler2(zaehler1)
End Function

einzufuegen
alt+f11/Projektexplorer/DeineTabelle

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim Bereich(2) As String
    Dim zaehler As Integer
    Bereich(0) = "A1,B1,C1"
    Bereich(1) = "F5,G1,I5"
    Bereich(2) = "H2,H5,H7"
    For zaehler = 0 To 2
        If Range(StrBe(Bereich(zaehler), 1)) = Cells(Target.Row, Target.Column) And Cells(Target.Row, Target.Column) <> "" Then Wert(zaehler) = True
        If Range(StrBe(Bereich(zaehler), 3)) <> "" Then Wert(zaehler) = False
    Next zaehler
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    ReDim Bereich(2) As String
    Dim zaehler As Integer, zaehler0 As Integer
    Bereich(0) = "A1,B1,C1"
    Bereich(1) = "F5,G1,I5"
    Bereich(2) = "H2,H5,H7"
    For zaehler = 0 To 2
        If Wert(zaehler) = True Then
            For zaehler0 = 2 To 3
                If Range(StrBe(Bereich(zaehler), zaehler0)) = "" Then
                    Range(StrBe(Bereich(zaehler), zaehler0)).Select
                    Exit For
                End If
            Next zaehler0
        End If
    Next zaehler
    Application.EnableEvents = True
End Sub