Wieso wird der 2.Teil nicht ausgeführt
28.08.2014 18:35:35
walter mb
Hallo zusammen,
wieso wird der 2. Teil des Makros nicht ausgeführt.
Das Makro "löschen" klappt nicht.
mfg walter mb
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim vntNewValue As Variant
Dim lrgRange As Range
On Error GoTo ERR_Handler
Set lrgRange = Range("B3:B65000")
If Intersect(Target, lrgRange) Is Nothing Then Exit Sub
With Target
If .Count = 1 Then
Select Case .Value
Case "best": vntNewValue = "Bestandskunde"
Case "bes": vntNewValue = "Besuch"
Case "gs": vntNewValue = "Gelbe Seiten"
Case "gsb": vntNewValue = "Gelbe Seiten Buch"
Case "gsi": vntNewValue = "Gelbe Seiten Internet"
Case "go": vntNewValue = "Google"
Case "gom": vntNewValue = "Google S-Markisen"
Case "gos": vntNewValue = "Google S-Sonnenschutz"
Case "i": vntNewValue = "Internet"
Case "ver": vntNewValue = "Vermittlung"
Case "vorb": vntNewValue = "Vorbeifahrt"
Case "wei": vntNewValue = "Weiterempfehlung"
Case "wu": vntNewValue = "Wohnt Umkreis"
Case "z": vntNewValue = "Zeitung"
Case Else: vntNewValue = .Value
End Select
Application.EnableEvents = False
.Value = vntNewValue
End If
End With
ERR_Handler:
Application.EnableEvents = True
'End Sub
'
Private Sub wWorksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 13 Then
On Error GoTo ErrHandler
Application.EnableEvents = False
Call löschen
End If
ErrHandler:
Application.EnableEvents = True
End Sub