Text während der Eingabe ersetzen

Hallo,
ich habe ein kleines Problem, bei dessen Lösung ich um Hilfe bitte:
Ich muss bei einem Wettbewerb ein Bewertungsblatt ausfüllen. Die jeweiligen Punkte werden mir von
einem Moderator im Saal angesagt. Voriges Jahr habe da ziemlichen Stress gehabt und auch gelegentlich Fehler produziert. Um heuer schneller zu sein, habe ich mir überlegt, nur ein Kürzel (z.B. "7") einzugeben, welches bei der Eingabe durch die tatsächliche Zahl (z.B. "10") ersetzt wird.
Suchen/Ersetzen bzw. Autokorrektur scheiden aus, da diese über das ganze Tabellenblatt arbeiten und das möchte ich nicht.
Ich denke, dass nur VBA bleibt.
Die Ersetzungen während der Eingabe sollen nur im Bereich F11 - H20 und J11 - L20 passieren.
Ersetzt soll werden:
1 durch 7
2 durch 7,5
3 durch 8
4 durch 8,5
5 durch 9
6 durch 9,5
7 durch 10
Ich wäre für Tips dankbar!
lg
walter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Walter,
ins Codemodul des Tabellenblattes:


Private Sub Worksheet_Change(ByVal Target As Range)
Const b = "F11:H20,J11:L20"
Dim z As Range, ber As Range
Dim neu As Variant
Set ber = Intersect(Target, Range(b))
If Not ber Is Nothing Then
For Each z In ber
Select Case z.Value
Case 1: neu = 7
Case 2: neu = 7.5
Case 3: neu = 8
Case 4: neu = 8.5
Case 5: neu = 9
Case 6: neu = 9.5
Case 7: neu = 10
Case Else: neu = -1
End Select
If neu > 0 Then
On Error Resume Next
Application.EnableEvents = False
z.Value = neu
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler Nr." & Err.Number
On Error GoTo 0
Application.EnableEvents = True
End If
Next z
End If
End Sub

Gruß Matthias

Private Sub Worksheet_Change(ByVal Target As Range) Dim bOK As Boolean If Intersect(Target, Range("F11:H20", "J11:L20")) Is Nothing Or _ Target.Cells.Count > 1 Then Exit Sub Application.EnableEvents = False If Target.Value = Val(Target.Value) Then If Target.Value 7 Then Else Target.Value = _ WorksheetFunction.Index(Array(7, 7.5, 8, 8.5, 9, 9.5, 10), Target.Value) bOK = True End If End If If Not (bOK) Then MsgBox "Wert muss zwischen 1 und 7 sein!", vbOKOnly + vbExclamation Target.Value = "" Target.Activate End If Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("F11:H20", "J11:L20")) Is Nothing Or Target.Count > 1 Then Exit _ Sub Application.EnableEvents = False Target = Target / 2 + 6.5 Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim zahl As Integer If Intersect(Target, Range("F11:H20", "J11:L20")) Is Nothing Or Target.Count > 1 Then Exit _ Sub zahl = Target If zahl 7 Then MsgBox "Falsche Eingabe!" Exit Sub End If Application.EnableEvents = False Target = zahl / 2 + 6.5 Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim zahl As Integer, rng As Range If Intersect(Target, Range("F11:H20", "J11:L20")) Is Nothing Then Exit Sub For Each rng In Target 'Ganzzahl zahl = Val(rng) If zahl 7 Then 'Falsche Eingabe Application.EnableEvents = False rng = -1 Application.EnableEvents = True Else 'Umrechnung Application.EnableEvents = False rng = zahl / 2 + 6.5 Application.EnableEvents = True End If Next End Sub

Beliebteste Forumthreads (12 Monate)

Text während der Eingabe ersetzen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Text während der Eingabe ersetzen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread