AW: Fehler im Makro
08.03.2020 16:06:07
Regina
Hi,
dann teste mal diesen Code:
Sub Ruelas_summe()
' suchen_Ergebnis und Zeile Färben
Dim wks As Worksheet
Dim x As Range
Dim rngCell As Range
Dim lng_zeile As Long
Dim dat_letzter_tag As Date
For Each wks In Worksheets
With wks
For Each x In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Cells
If InStr(1, x, "Ergebnis") Then x.EntireRow.Columns("A:N").Interior.ColorIndex = _
_
35
If InStr(1, x, "Gesamtergebnis") Then x.EntireRow.Columns("A:N").Interior. _
ColorIndex = 19
If InStr(1, x, "Rülas Ergebnis") Then
.Cells(x.Row, 13) = Application.WorksheetFunction.Sum(.Cells(x.Row, 10), . _
_
Cells(x.Row, 12)) * -1
If .Cells(x.Row, 13) = .Cells(x.Row, 2) Then
lng_zeile = x.Row + 1
dat_letzter_tag = DateSerial(Year(.Cells(x.Row - 1, 3)), Month(.Cells(x. _
_
Row - 1, 3)), letzter_tag(Month(.Cells(x.Row - 1, 3)), Year(.Cells(x.Row - 1, 3))))
If .Cells(x.Row, 10).Value 0 Then
Rows(lng_zeile).Insert
Rows(lng_zeile).ClearFormats
.Cells(lng_zeile, 2) = .Cells(x.Row, 10) * -1
.Cells(lng_zeile, 1) = "Rülas Abschlag"
.Cells(lng_zeile, 8) = "Rülas Abschlag"
.Cells(lng_zeile, 3) = dat_letzter_tag
lng_zeile = lng_zeile + 1
End If
If .Cells(x.Row, 11).Value 0 Then
Rows(lng_zeile).Insert
Rows(lng_zeile).ClearFormats
.Cells(lng_zeile, 2) = .Cells(x.Row, 11) * -1
.Cells(lng_zeile, 1) = "Rüla Eigenentgelt"
.Cells(lng_zeile, 8) = "Rüla Eigenentgelt"
.Cells(lng_zeile, 3) = dat_letzter_tag
lng_zeile = lng_zeile + 1
End If
If .Cells(x.Row, 12).Value 0 Then
Rows(lng_zeile).Insert
Rows(lng_zeile).ClearFormats
.Cells(lng_zeile, 2) = .Cells(x.Row, 12) * -1
.Cells(lng_zeile, 1) = "Rüla Fremdentgelt"
.Cells(lng_zeile, 8) = "Rüla Fremdentgelt"
.Cells(lng_zeile, 3) = dat_letzter_tag
End If
End If
End If
Next
End With
Next
End Sub
Public Function letzter_tag(lng_monat As Long, lng_jahr As Long) As Long
Select Case lng_monat
Case 1, 3, 5, 7, 8, 10, 12
letzter_tag = 31
Case 4, 6, 9, 11
letzter_tag = 30
Case 2
If schaltjahr(lng_jahr) = True Then
letzter_tag = 29
Else
letzter_tag = 28
End If
End Select
End Function
Public Function schaltjahr(lng_jahr As Long) As Boolean
If Not (lng_jahr Mod 4) = 0 Then
' nicht durh 4 teilbar
schaltjahr = False
ElseIf (lng_jahr Mod 100) = 0 And Not ((lng_jahr Mod 400) = 0) Then
' durch 100 teilbar: 1800,1900
schaltjahr = False
Else
' aber doch durch 400 teilbar: 2000
schaltjahr = True
End If
End Function
Bei der Zeile "dat_letzter_tag=" musst Du den automatischen Zeilenumbruch rausnehmen.
Gruß Regina