AW: Laufzeitfehler 91
21.03.2020 01:56:51
fcs
Hallo GFifiFox,
du hast eine wichtige Information vergessen:
In welcher Zeile des Codes/Makros tritt der Fehler auf? So kann ich nur raten wo das Problem ist.
In deinem neuen Makro ist ein Problem in folender Zeile möglich, wenn das Blatt "" zum Zeipunkt der Makroausführung nicht das aktive Tabellenblatt ist.
For Each c In Worksheets("Mitarbeiteransicht").Range(Cells(5, j + 1), Cells(36, j + 1))
Du hast vor "Cells" keine Referenz zu einem Tabellenblatt angegeben. Ist "Mitarbeiteransicht" das aktive Blatt dann funktioniert das Makro, wenn nicht gibt es einen Fehler.
Du müsstest die Zeile wie folgt anpassen:
For Each c In Worksheets("Mitarbeiteransicht").Range( _
Worksheets("Mitarbeiteransicht").Cells(5, j + 1), _
Worksheets("Mitarbeiteransicht").Cells(36, j + 1))
Ich kann nur nochmals empfehlen mit Objektvariablen für die Tabellenblätter zu arbeiten und mit
With ... End With Kontrukten.
Dann muss man die elendig langen Worksheet-Namen nicht immer wieder wiederholen.
LG
Franz
Sub TZF_Import()
Dim myArray2() As Variant
Dim myArray1() As Variant
Dim i As Variant
Dim Counter_Übertrag As Integer
Dim wksTZ As Worksheet
Dim wksMA As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set wksTZ = Worksheets("TZ")
Set wksMA = Worksheets("Mitarbeiteransicht")
Mitarbeiter = wksMA.Cells(2, 4)
With wksTZ
With .Range(.Cells(1, 1), .Cells(500, 1)) ' _
maximal 500 TZ-Einträge
Set c = .Find(Mitarbeiter, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
n = n + 1
ReDim Preserve myArray1(n)
myArray1(n) = c.Row
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
End With 'wksTZ
MsgBox Join(myArray1, vbLf)
For Each i In myArray1
Erase myArray2
For Each c In .Range(.Cells(i, 4), .Cells(i, 8))
Select Case c
Case "x"
n = n + 1
ReDim Preserve myArray2(n)
If .Cells(1, c.Column).Value = "Mo" Then
Tag = 1
ElseIf .Cells(1, c.Column).Value = "Di" Then
Tag = 2
ElseIf .Cells(1, c.Column).Value = "Mi" Then
Tag = 3
ElseIf .Cells(1, c.Column).Value = "Do" Then
Tag = 4
ElseIf .Cells(1, c.Column).Value = "Fr" Then
Tag = 5
End If
myArray2(n) = Tag '.Cells(1, c.Column).Value
End Select
Next
MsgBox Join(myArray2, vbLf)
With wksMA
j = 1
Do While j = CDate(wksTZ.Cells(i, 2)) _
And CDate(c) 5 Then _
.Cells(c.Row, c.Column + 1) = ""
If FT_Vergleich(CDate(c)) = True Then _
.Cells(c.Row, c.Column + 1) = ""
End Select
Next c
j = j + 3
Loop
End With 'wksMA
Counter_Übertrag = Counter_Übertrag + 1
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub