Danke fcs....altes Problem aber bleibt....
14.06.2017 08:33:23
STeve
Danke an fcs.
Habe deine (zweite) Select Case Variante eingebaut.
Wenn ich über die Userform das Blatt "Mitarbeiterverwaltung" jetzt bearbeite - klappt es. DANKE........
aber wenn ich dann das neue Blatt - eben auch über die Userform - mit dem Namen:
"DPL PI BH " & FormularStarteingabeMaske.ComboMonat.Value & " " _
& FormularStarteingabeMaske.ComboJahr.Value
erstellen lasse zeigt er bei:
Set objRange = Intersect(Target, Sh.Range("E18:AI" & EndZeilefürsZählwerk))
die Fehlermeldung: Anwendungs- oder objektdefinierter Fehler an?
Hier der Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case LCase(Sh.Name)
Case LCase("DPL PI BH " & FormularStarteingabeMaske.ComboMonat.Value & " " _
& FormularStarteingabeMaske.ComboJahr.Value)
Dim objRange As Range, objCell As Range
Dim lngRow As Long
Dim x As Integer
Dim EndZeilefürsZählwerk As Integer ' in dieser Schleife sucht er das Wort "soll" unter dem _
letzten Mitarbeiter und zählt die Zeilen aus
For x = 1 To Range("A65536").End(xlUp).Row - 1
If ActiveSheet.Cells(x, 1) = "soll" Then
EndZeilefürsZählwerk = x - 1 ' von diesem Wert wird eine Zeile _
abgezogen dann zählt es die letzte Zeile des letzten Mitarbeiters
End If
Next x
Set objRange = Intersect(Target, Sh.Range("E18:AI" & EndZeilefürsZählwerk)) ' _
Hilfe/Tipp von EtoPHG ... Sh.Range - verwenden
If Not objRange Is Nothing Then
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each objCell In objRange.Columns
For lngRow = EndZeilefürsZählwerk + 2 To Cells(Rows.Count, 3).End(xlUp).Row ' ist _
die Zeile wo der erste Begriff (DF usw) anfängt
Cells(lngRow, objCell.Column).Value = count_values(Cells(lngRow, 3).Text, _
objCell.Column)
Next
Call change_color(objCell.Column)
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
ElseIf Not Intersect(Target, Sh.Range("A" & EndZeilefürsZählwerk + 2 & ":A" & Cells( _
Rows.Count, 1).End(xlUp).Row)) Is Nothing Then 'von Matthias
' ElseIf Not Intersect(Target, Sh.Range(Cells(EndZeilefürsZählwerk + 2, 1), Cells(Rows. _
Count, 1))) Is Nothing Then 'Alternative von Matthias
Dim LastCol As Integer, i As Long
With ActiveSheet
LastCol = .Cells(Target.Row, .Columns.Count).End(xlToLeft).Column - 2 ' es wird die _
Spaltenanzahl ausgezählt wo die Begriffe gezählt werden sollen
End With
For i = 5 To LastCol ' beginnend bei 5 also Spalte E
Call change_color(i) ' führe das Modul - weiter unten - Wechsle Farbe aus
Next i
End If
Set objRange = Nothing
Case Else
'do nothing
End Select
End Sub
Was ist da falsch?
Bedanke mich für eure Mühen und Unterstützung, Hilfe und Tipps.
mfg und LG
STeve