AW: oh Mann :-( ich bin raus
16.03.2022 14:01:32
Schlins
Die Zuweisung vorher im Code erschien mir an dieser Stelle nicht relevant. Du hast Recht, sinnvoll ist es den ganzen Code zu kennen;
Sub Datensatz_einlesen()
Dim s As Object
Dim i1 As Integer
Dim j1 As Integer
Dim j2 As Integer
Dim j3 As Integer
Dim j4 As Integer
Dim Buchungsdatum As Variant
Dim Ressourcennummer As Variant
Dim Arbeitstypencode As Variant
Dim Kalendertag As Variant
Dim Stundenanzahl As Variant
Dim c As Range
Dim z As Range
Set s = Sheets("Ressourcenposten").Rows(1).Find("Ressourcennr.")
If Not s Is Nothing Then
j = s.Column
End If
Set s = Sheets("Ressourcenposten").Rows(1).Find("Buchungsdatum")
If Not s Is Nothing Then
j1 = s.Column
End If
Set s = Sheets("Ressourcenposten").Rows(1).Find("Ressourcennr.")
If Not s Is Nothing Then
j2 = s.Column
End If
Set s = Sheets("Ressourcenposten").Rows(1).Find("Arbeitstypencode")
If Not s Is Nothing Then
j3 = s.Column
End If
Set s = Sheets("Ressourcenposten").Rows(1).Find("Menge")
If Not s Is Nothing Then
j4 = s.Column
End If
Ressourcenposten = Sheets("Urlaubskarte").Cells(2, "B").Value
'Sheets("Ressourcenposten").ListObjects("Table1").ShowAllData
Sheets("Ressourcenposten").ListObjects("Table1").Range.AutoFilter Field:=j
Sheets("Ressourcenposten").ListObjects("Table1").Range.AutoFilter Field:=j1
Sheets("Ressourcenposten").ListObjects("Table1").Range.AutoFilter Field:=j2
Sheets("Ressourcenposten").ListObjects("Table1").Range.AutoFilter Field:=j3
Sheets("Ressourcenposten").ListObjects("Table1").Range.AutoFilter Field:=j, Criteria1:= _
Ressourcenposten
ActiveWorkbook.Worksheets("Ressourcenposten").ListObjects("Table1").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Ressourcenposten").ListObjects("Table1").Sort. _
SortFields.Add2 Key:=Range("Table1[[#All],[Ressourcennr.]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Ressourcenposten").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Set c = Sheets("Ressourcenposten").Range("A2:R1048576").SpecialCells(xlCellTypeVisible)
Set c = Sheets("Ressourcenposten").Range("A2:R" & Sheets("Ressourcenposten").Cells(Rows.Count, "R").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
For Each z In c.Rows
If IsEmpty(z) Then
GoTo Sprungzeile:
End If
Buchungsdatum = Sheets("Ressourcenposten").Cells(z.Row, j1)
Ressourcennummer = Sheets("Ressourcenposten").Cells(z.Row, j2)
Arbeitstypencode = Sheets("Ressourcenposten").Cells(z.Row, j3)
Stundenanzahl = Sheets("Ressourcenposten").Cells(z.Row, j4)
Set s = Sheets("Urlaubskarte").Range("G7:DK40").Find(Buchungsdatum, lookat:=xlWhole, LookIn:=xlValues)
If Not s Is Nothing Then
Kalendertag = s.Address
End If
Select Case Arbeitstypencode
Case Is = "FEIERTAG"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "F"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(112, 48, 160) 'Lila
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "URLAUB"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "U"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(112, 173, 71) 'Grün
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "ANAB_AUSL"
With Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936 'Grün
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case Is = "AUSL"
With Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407 'Orange
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case Is = "ABFEIERN"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "abf"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(255, 217, 102) 'Senffarben
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "KRANK/KUR"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "K"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(0, 0, 0) 'Schwarz
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "HEIMFAHRT"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-2, 1) = "HF" 'Sonderfeld Mitte
Case Is = "NACHT"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-2, 2) = Stundenanzahl 'Sonderfeld rechts
Case Is = "RUFBEREIT"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-2, 0) = "B" 'Sonderfeld
Case Is = "FEIERTAG_G"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "FX"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(112, 48, 160) 'Lila
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "SCHULE"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "S"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(255, 0, 0) 'Rot
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "UNBEZAHLT"
With Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255 'Rot
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case Is = "BUMMELEI"
With Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255 'Rot
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case Is = "SONNTAG"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "SX"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(112, 48, 160) 'Lila
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "QUARANTÄNE"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "Q"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(0, 0, 0) 'Schwarz
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "UNFALL"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "AU"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(0, 0, 0) 'Schwarz
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "KRANK_KIND"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "KK"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(0, 0, 0) 'Schwarz
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "KRANK_6WO"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "K6"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(0, 0, 0) 'Schwarz
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "ELTERN"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "EZ"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(255, 153, 255) 'Rosa
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
Case Is = "KUR"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0) = "KU"
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Color = RGB(0, 0, 0) 'Schwarz
Sheets("Urlaubskarte").Range(Kalendertag).Offset(-1, 0).Font.Bold = True
End Select
Sprungzeile:
Next
End Sub