Office: VBA - Springen in nächste ungeschützte Zelle ohne TAB/Enter

Hallo.

Ich habe folgendes vor:

Auf meinem mit Blattschutz geschütztem Arbeitsblatt habe ich geschützte und ungeschützte Zellen in unterschiedlicher Anordnung.
Befüllt werden die ungeschützten Zellen mit einem Klick auf unterschiedliche Schaltflächen, die mit Makros hinterlegt sind.
Wie bekomme ich es hin, dass nach Betätigen einer Schaltfläche (und damit Befüllen der ausgewählten Zelle) die nächste ungeschützte Zelle automatisch angesteuert wird, ohne dass ich dies mit TAB oder Enter bestätigen muss?
Bisher habe ich die Anzahl der zu überspringenden Zellen in dem Makro der jeweiligen Schaltfläche selbst festgelegt, da aber die Anzahl der geschützten Zellen zu den ungeschützten Zellen, ist das nicht praktikabel (ActiveCell.Offset(2, 0).Select).

Ich habe hier im Forum folgenden Befehl gefunden, von dem ich dachte, dass er mein Problem löst, leider funktioniert er nicht oder ich mache damit was falsch:

vba - zu erster nicht gesperrter Zelle springen

Ich danke euch für eure Hilfe.
Grüße

 

Hi,

ich nehme an, du hast ein bestimmtes System, welches die nächste Zelle sein soll. Dann kannst du im Code für das Ausfüllen der Zellen doch die nächste gewünschte Zelle direkt ansteuern - anstelle ActiveCell.Offset(2, 0).Select einfach die Zelladresse angeben: Range("A10").Select

---

 

Hallo Karin.

Vielen Dank für deine Antwort.
Leider soll es tatsächlich kein festgelegtes System geben. In meinem Arbeitsblatt gibt es ca. 140 Schaltflächen zur Auswahl und ca. 100 ungeschützt Felder zum Befüllen, die jedes Mal ganz unterschiedlich mit den Schaltflächen zu befüllen sind. Ein fest definierte Reihenfolge der Zellen wäre meine letzte Möglichkeit, da dieser Befehl vermutlich sehr umfangreich ausfallen würde. Von daher war meine Idee einen (einfacheren) Befehl zu haben, der dafür sorgt, dass einfach immer die nächste ungeschützte Zelle angesprungen wird.

 

Hallo,

ohne deine Datei zu kennen, wird es schwierig, Lösungsvorschläge zu erstellen.

 

Hallo Klaus-Dieter, Hallo Karin.


Ich habe mittlerweile deinen Rat (Karin) umgesetzt und jede Zelle einzeln als feste Reihenfolge festgelegt.

Mein Befehl sieht folgendermaßen aus:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then ActiveSheet.Range("A4").Activate '
If Target.Address = "$A$4" Then ActiveSheet.Range("A6").Activate '
If Target.Address = "$A$6" Then ActiveSheet.Range("A8").Activate '
If Target.Address = "$A$8" Then ActiveSheet.Range("A10").Activate '
If Target.Address = "$A$10" Then ActiveSheet.Range("C14").Activate '
usw. usw.

Ist bei der Menge an Zellen ein sehr langer Befehl, aber so klappt es wie gewünscht.


Vielen Dank für deine/eure Hilfe.


Vielleicht könnt ihr mir beim folgenden Problem auch helfen:


Änderung Schaltflächenfarbe beim Anklicken

Grüße

 

Hi,

mit einem kleinen Trick lässt sich das vereinfachen:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a
Dim b As String
Dim i As Long
a = Split("A2 A4 A6 A8 A10 A2")
b = Target.Address(0, 0)
For i = 0 To UBound(a)
    If a(i) = b Then Exit For
Next i
If i < UBound(a) Then Range(a(i + 1)).Select
End Sub

In den String von Split() trägst du deine Adressen durch Leerzeichen getrennt ein. Ganz am Ende kommt noch einmal die erste Adresse.

 

Hallo Helmut.

Vielen Dank.

Wenn ich das so übernehme, zeigt er mir folgende Fehlermeldung an: Laufzeitfehler 28: Nicht genügend Stapelspeicher

Im Debuggen ist dieser Bereich gelb markiert: Range(a(i + 1)).Select

 

Hi,

das geht auch einfacher: schreibe die Zelladressen in zwei Arrays - 1. Array Adresse der Startzelle (also Target) und 2. Array Zielzelle:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arrQuelle()
    Dim arrZiel()
    Dim lngZelle As Long
    arrQuelle = Array("A2", "A4", "A6", "A8", "A10", "C14")
    arrZiel = Array("A4", "A6", "A8", "A10", "C14", "A2")
    lngZelle = Application.Match(Target.Address(0, 0), arrQuelle(), 0)
    Range(arrZiel(lngZelle - 1)).Select
End Sub

---

 

Vielen Dank für deinen Befehl, Beverly.
Leider beißt sich dieser dann mit meinem Befehl, alle Felder mit einem Klick zu leeren:

Sub AllesLeeren()
'
' AllesLeeren2 Makro
Range("Aufgaben").Value = ""
End Sub

Als Fehlermeldung kommt: Typen unverträglich, Debuggen zeigt dann die drittletzte Zeile deines o.a. Befehls als Fehler an:

lngZelle = Application.Match(Target.Address(0, 0), arrQuelle(), 0)

 

Hi,

schreibe den Code für das Change-Ereignis so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arrQuelle()
    Dim arrZiel()
    Dim lngZelle As Long
    If Target.Count = 1 Then
        arrQuelle = Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15")
        arrZiel = Array("A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16")
        lngZelle = Application.Match(Target.Address(0, 0), arrQuelle(), 0)
        Range(arrZiel(lngZelle - 1)).Select
    End If
End Sub

Und den Code für das Leeren des gesamten Bereichs so:

Code:

Sub AllesLeeren()
'
' AllesLeeren2 Makro
    Range("Aufgaben").Value = ClearContents
    Zuruecksetzen '<== Makro zum Zurücksetzen der Farben der Schaltflächen
End Sub

Der Code für das Makro Zuruecksetzen steht in deinem anderen Thread.

---

 

Hi,

sorry bei meinem Code hatte sich ein Fehler eingeschlichen. Ich hatte das falsche Event verwendet.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a
Dim b As String
Dim i As Long
a = Split("A2 A4 A6 A8 A10 A2")
b = Target.Address(0, 0)
For i = 0 To UBound(a)
    If a(i) = b Then Exit For
Next i
If i < UBound(a) Then Range(a(i + 1)).Select
End Sub

Im Grunde ist das der selbe Code wie bei Beverly. Nur musst du bei mir das Array nur 1 Mal angeben und brauchst nicht so viele "-Zeichen und Kommata.
Außerdem wird kein Fehler auftreten, wenn mehrere Zellen gleichzeitig geändert werden, oder eine Zelle außerhalb des erwähnten Bereichs geändert wird.

 

Hi Helmut,

den Fehler beim Eintragen in eine andere Zelle außer den vorgegebenen könnte man ganz einfach umgehen, indem man die Reaktion nur auf den betreffenden Bereich begrenzt:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arrQuelle()
    Dim arrZiel()
    Dim lngZelle As Long
    If Not Intersect(Target.Cells(1), Range("A2:A16")) Is Nothing Then '<== nur im Bereich A2:A16 wirksam
        If Target.Count = 1 Then
            arrQuelle = Array("A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16")
            arrZiel = Array("A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10", "A11", "A12", "A13", "A14", "A15", "A16", "A2")
            lngZelle = Application.Match(Target.Address(0, 0), arrQuelle(), 0)
            Range(arrZiel(lngZelle - 1)).Select
        End If
    End If
End Sub

Ist aber im Prinzip nicht notwendig, da nur die vorgegebenen Zellen bearbeitet/ausgewählt werden können, da sie ensperrt sind (siehe Eröffnungsbeitrag).

Außerdem sind unsere beiden Codes doch ziemlich verschieden, da du die Adressen in einer Schleife durchlaufen musst, mein Code dagegen die betreffende Adresse mittels Vergleich ganz einfach findet.

---

 

Hi Karin,

ob man jetzt ein Array selbst durchsucht oder WorksheetFunction.Match verwendet: wo ist der große Unterschied? Beides mal wird eine Liste durchsucht. Also ist es im Grunde doch das Gleiche.
Ok, ich brauche nur eine Quelle, du auch noch ein Ziel. Wobei, wenn du an deine Quelle hinten nochmals die erste Zelle anhängen und dann Range(arrQuelle(lngZelle)).Select statt Range(arrZiel(lngZelle - 1)).Select verwenden würdest, dann wäre dein Code auch einfacher. Dann noch zuvor prüfen ob lngZelle > 0 ist, dann kannst du dir auch noch das Intersect() und das Prüfen von Target.Count sparen.

 

Ist eben nicht das Gleiche - du benötigst eine Schleife, mein Code macht das in einem Zug.

Es geht aber auch komplett ohne Arrays:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target.Cells(1), Range("Aufgaben")) Is Nothing Then
        If Target.Count = 1 Then
            If Intersect(Target, Range("Aufgaben").Cells(Range("Aufgaben").Count)) Is Nothing Then
                Intersect(Range("Aufgaben"), Target).Offset(1, 0).Select
            Else
                Range("Aufgaben").Cells(1).Select
            End If
        End If
    End If
End Sub

Anstelle dem benannten Bereich Range("Aufgaben") kann man natürlich auch den Zellbereich - z.B. "A2:A16" - angeben.

---

 

Hi Karin,
und was macht Match() wohl intern? Zaubert es die Lösung aus dem Hut oder wird der Bereich durchsucht, vermutlich mit einer Schleife (wie denn sonst, wenn der Bereich nich sortiert ist)? Aber lass‘ gut sein. Es lohnt sich nicht darüber zu streiten.

Funktioniert deine neue Lösung mit Offset übrigens auch in einem nicht zusammen hängenden Bereich? Immerhin war das ja vom TE gefordert. Schreibe gerade am iPad und kann es nicht selbst testen…