Beitrag aus SmartTools Excel Weekly
Eingabe von Ziffern in nicht zusammenhängenden Spalten verhindern
Excel 365 2021 2019 2016 2013 2010
Vor kurzem haben wir eine Ereignisprozedur "Worksheet_Change" vorgestellt, mit der sich die Eingabe von Ziffern in einem bestimmten Bereich verhindern lässt. Uns haben einige Anfragen von Lesern erreicht, die die Zifferneingabe aber nicht nur in einer, sondern gleich in mehreren Spalten verhindern möchten. Das Problem: Die Spalten sind nicht zusammenhängend, so dass Sie als Eingabebereich nicht einfach "A2:E100" angeben können. Die Eingabe soll beispielsweise nur in A3:A20, C3:C10 und E3:E15 überwacht werden. In den Spalten B und D soll die Zifferneingabe aber zulässig sein. Wir zeigen in diesem Tipp, wie Sie das Problem lösen.
Um die Eingabe in mehreren, nicht zusammenhängenden Bereichen mit dem "Worksheet_Change"-Ereignis zu überwachen, definieren Sie in der Prozedur entsprechend viele "Range"-Objekte, die Sie dann mit der "Union"-Methode zu einem Gesamtbereich zusammenführen. So hält sich der Änderungsaufwand an der Ereignisprozedur in minimalen Grenzen.
Die Zifferneingabe in den von Ihnen genannten Bereichen verhindern Sie somit auf folgende Weise:
- Klicken Sie mit der rechten Maustaste auf das Blattregister der Tabelle, in der Sie die Eingabe beschränken wollen, und wählen Sie im Kontextmenü Code anzeigen an.
- Wenn Sie bereits eine "Worksheet_Change"-Prozedur angelegt hatten, gehen Sie in dem Codefenster des Visual Basic-Editors direkt dorthin. Oder Sie legen die Prozedur neu an, indem Sie in den Dropdownfeldern am oberen Rand des Codefensters zuerst links den Eintrag "Worksheet" und dann rechts den Eintrag "Change" auswählen.
- Nun ändern Sie die Prozedur wie folgt:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rgInput As Range
Dim cInputCell As Range
Dim rgInvalid As Range
Dim rgInput1 As Range
Dim rgInput2 As Range
Dim rgInput3 As Range
Set rgInput1 = ActiveSheet.Range("A3:A20")
Set rgInput2 = ActiveSheet.Range("C3:C10")
Set rgInput3 = ActiveSheet.Range("E3:E15")
Set rgInput = Application.Union _
(rgInput1, rgInput2, rgInput3)
If Not Application.Intersect(rgInput, Target) _
Is Nothing Then
For Each cInputCell In Target.Cells
If cInputCell.Value Like "*#*" Then
If rgInvalid Is Nothing Then
Set rgInvalid = cInputCell
Else
Set rgInvalid = Application _
.Union(rgInvalid, cInputCell)
End If
End If
Next cInputCell
If Not rgInvalid Is Nothing Then
rgInvalid.Select
MsgBox _
Prompt:="Bitte keine Ziffern eingeben!", _
Title:="Ungültige Eingabe"
rgInvalid.Clear
End If
End If
Set rgInvalid = Nothing
Set cInputCell = Nothing
Set rgInput = Nothing
Set rgInput1 = Nothing
Set rgInput2 = Nothing
Set rgInput3 = Nothing
End Sub
Im Gegensatz zur Prozedur aus der zurückliegenden Excel Weekly-Ausgabe müssen Sie nur zusätzliche "Range"-Objekte für die einzelnen Eingabebereiche hinzufügen - hier "rgInput1" bis "rgInput3" mit den entsprechenden Bereichsadressen:
Dim rgInput1 As Range
Dim rgInput2 As Range
Dim rgInput3 As Range
Set rgInput1 = ActiveSheet.Range("A3:A20")
Set rgInput2 = ActiveSheet.Range("C3:C10")
Set rgInput3 = ActiveSheet.Range("E3:E15")
Außerdem fügen Sie eine Anweisung ein, die die einzelnen "Range"-Objekte zu einem Gesamtbereich ("rgInput") zusammenfügt:
Set rgInput = Application.Union _
(rgInput1, rgInput2, rgInput3)
Der Ordnung halber geben Sie ganz am Ende der Prozedur auch noch die Ressourcen der zusätzlichen "Range"-Objekte frei:
Set rgInput1 = Nothing
Set rgInput2 = Nothing
Set rgInput3 = Nothing
Weitere Änderungen sind nicht erforderlich.