Problem beim Kopieren mit CASE

Hallo Leute
Habe ein Problem mit Kopieren von Werten in ein Tabellenblatt.
Die Werte werden von einen Tabellenblatt in Tabellenblatt "Jänner" kopiert.
Unter Code steht in "Jänner"
Nun kommt aber die Fehlermeldung "Typen Unverträglich"
Der Fehler wird bei
Select Case UCase(Zelle.Value) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
angezeigt.
Warum ?
Danke
Heinz
Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="vetro"
Dim Name_Bereich, Kal_Bereich As Range, Zelle As Range
Dim wks As Worksheet, FarbeZ As Long, FarbeF As Long, Zeile As Long
Set Kal_Bereich = Range("C3:AI154") 'Bereich in dem was geändert wird
Set Name_Bereich = Range("A3:B154") 'Bereich mit Name und Schicht
Set Kal_Bereich = Intersect(Kal_Bereich, Target)
Set Name_Bereich = Intersect(Name_Bereich, Target)
If Not Kal_Bereich Is Nothing Then
For Each Zelle In Kal_Bereich
'Farben entsprechend Wert in Zelle setzen
Select Case UCase(Zelle.Value) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
Case "A= ANDERE ABWESENHEIT"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case "A"
FarbeZ = 21: FarbeF = 2 'violett - weiß

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Heinz,
keine Ahnung woran es liegen kann. Die Prüfung funktioniert bei Eingabe von Zahlen als auch Texten. Probleme gibt es, wenn in den kopierten Zellen Formeln enthalten sind, die als Ergebnis einen Fehlerwert anzeigen.
Das könntest du durch folgende Anpassung umgehen. Die Meldung kannst du natürlich auch weglassen. Sie dient zur Anzeige der Problemzelle(n).
Gruß
Franz

Sub Worksheet_Change(ByVal Target As Range)
Dim Name_Bereich, Kal_Bereich As Range, Zelle As Range
Dim wks As Worksheet, FarbeZ As Long, FarbeF As Long, Zeile As Long
ActiveSheet.Unprotect Password:="vetro"
Set Kal_Bereich = Range("C3:AI154")  'Bereich in dem was geändert wird
Set Name_Bereich = Range("A3:B154")  'Bereich mit Name und Schicht
Set Kal_Bereich = Intersect(Kal_Bereich, Target)
Set Name_Bereich = Intersect(Name_Bereich, Target)
If Not Kal_Bereich Is Nothing Then
For Each Zelle In Kal_Bereich
If IsError(Zelle.Value) Then
MsgBox "Fehlerwert in Zelle " & Zelle.Address, vbInformation + vbOKOnly, _
"Zellen formatieren"
FarbeZ = 2: FarbeF = 0
Else
'Farben entsprechend Wert in Zelle setzen
Select Case UCase(Zelle.Value) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
Case "A= ANDERE ABWESENHEIT"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case "A"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case "B= BEZAHLT FREI"
FarbeZ = 7: FarbeF = 2 'rosa - weiß
Case "B"
FarbeZ = 7: FarbeF = 2 'rosa - weiß
Case Else
FarbeZ = 2: FarbeF = 0
End Select
With Zelle
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
End With
End If
Next Zelle

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread