Bewertungsformular, erwartete Eingabe 5,4,3,2,1
12.12.2013 21:27:04
Peter
Ich kreiere ein Bewertungsformular, in dem es verschiedene Bereiche mit je 5 aufeinander folgenden Zellen in einem Spaltenbereich hat.
Diese Bereiche sind jeweils benannt, z.B. "_xBereich1"
Je nach Beurteilung von bestimmten Aussagen, wird pro Bereich eine Beurteilung abgegeben (zwischen 1 und 5).
Wenn in der obersten Zelle ein Eintrag erfolgt, werden allfällig bestehende Einträge gelöscht und in der obersten Zelle eine 5 eingetragen.
Für die zweite, dritte, vierte und fünfte Zelle erfolgt der Eintrag sinngemäss (4 resp. 3 resp 2 resp 1).
Mit nachfolgendem Code erhalte ich das gewünschte Resultat. Da ich jedoch vielleicht 18 - 24 verschiedene 5-er Blöcke habe ("_xBereich2", "-xBereich3", etc), habe ich mich gefragt, ob der Code möglicherweise vereinfacht werden könnte. Ich sehe allerdings den Ansatz im Moment nicht dazu.
Vielleicht hat jemand eine Idee?
Gruss, Peter
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("_xBereich1")) Is Nothing Then '"_xBereich1" = D1:D5
Else
Application.EnableEvents = False
Range("_xBereich1").ClearContents
If Target.Address = Range("_xBereich1")(1).Address Then Target.Value = 5
If Target.Address = Range("_xBereich1")(2).Address Then Target.Value = 4
If Target.Address = Range("_xBereich1")(3).Address Then Target.Value = 3
If Target.Address = Range("_xBereich1")(4).Address Then Target.Value = 2
If Target.Address = Range("_xBereich1")(5).Address Then Target.Value = 1
Application.EnableEvents = True
End If
End Sub
