Thema Datum  Von Nutzer Rating
Antwort
Rot Problem mit einer Schleife und Auswerung
31.12.2021 09:01:02 Martin Krantz
NotSolved
31.12.2021 09:37:15 Mase
NotSolved
01.01.2022 08:38:59 Gast71649
NotSolved
31.12.2021 15:19:24 Gast95007
NotSolved
01.01.2022 08:47:55 Gast69906
NotSolved
01.01.2022 15:59:47 Gast94521
NotSolved
02.01.2022 12:52:19 Gast32722
NotSolved
02.01.2022 14:40:40 Gast79641
NotSolved

Ansicht des Beitrags:
Von:
Martin Krantz
Datum:
31.12.2021 09:01:02
Views:
136
Rating: Antwort:
  Ja
Thema:
Problem mit einer Schleife und Auswerung

Liebes Forum

Ich komme leider mit folgendem Problem nicht weiter. Ich habe einen Code geschrieben um aus einer Tabelle mit dokumentierten Arbeitstagen Monatsauwertungen ausgeben zu lassen. Wen ich das Makro starte gebe ich als erstes in einer Dialogbox den Monat ein (1,2,3,...,12) und der Code liest dann alle Arbeitstage des entsprechenden Monats aus, schreibt die gewünschten Werte in ein neues Blatt und generiert am ende ein PDF. Für die Monate 1-11 klappt das super. Es werden nur die Zeilen für den Monat 11 ausgegeben und am ende die Summen.  Nur wenn ich das Makro für den Monat 12 starte, stoppt er nicht und ich bekomme ein vielseitiges Blatt und PDF mit den Zeilen für den Monat 12 und dan viele  Zeilen ohne Wert.  Die Auswertung der Summen erschein irgenwo mittendrinn.

Ich kann einfachn nicht finden, warum es bei der Eingabe 12 nicht funktioniert. 

Vielleicht kann mir jemand weiterhelfen?

Vielen Dank schon mal im Vorraus.

Hier der Code:

Sub monatrapport_neu_temp()


Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
Dim kopf As Long
Dim zeilex As Long
Dim zeilexz As Long

Dim monatstart As Variant
Dim monat As Integer

monat = InputBox("Bitte gewünschten Monat eingeben")

Sheets("BerichtMonat").Select

With Worksheets("BerichtMonat")
Worksheets("BerichtMonat").UsedRange.ClearContents

Tabelle6.Columns("a:z").NumberFormat = "[h]:mm"
End With
With Worksheets("BerichtMonat")

Range("a1:z5000").Interior.Color = vbWhite
Range("a1:z5000").Borders.LineStyle = -4142
Range("A1:z5000").Font.name = "Calibri"
Range("a1:z5000").Font.Bold = False
Range("a1:z5000").Font.Size = 10

kopf = 9
n = 10
zeilex = 0
ZeileMax = .UsedRange.Rows.Count

End With


startdienst:

With Worksheets("BerichtMonat")
Range("a" & kopf - 3).Value = "Name"
Range("b" & kopf - 3).Value = Worksheets("Dienst").Range("b3").Value
Range("a" & kopf - 2).Value = "Monat"
Range("b" & kopf - 2) = MonthName(monat)
Range("d" & kopf - 2).Value = "Jahr"
Range("e" & kopf - 2).Value = "2021"
Range("e" & kopf - 2).NumberFormat = "0000"
End With
With Worksheets("Dienst")
With Worksheets("BerichtMonat").Range("A" & kopf, "a" & kopf)

 .Value = "Dienst"
 .Font.Size = 13
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets("BerichtMonat").Range("d" & kopf, "d" & kopf)
 .Value = "Beginn"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets("BerichtMonat").Range("e" & kopf, "e" & kopf)
 .Value = "Ende"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With

With Worksheets("BerichtMonat").Range("f" & kopf, "f" & kopf)
 .Value = "Pause"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
With Worksheets("BerichtMonat").Range("g" & kopf, "g" & kopf)
 .Value = "Stunden"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
End With
 With Worksheets("BerichtMonat").Range("h" & kopf, "h" & kopf)
 .Value = "Nacht"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
 End With
  With Worksheets("BerichtMonat").Range("i" & kopf, "i" & kopf)
 .Value = "Sonntag"
 .Font.Size = 8
 .Font.Bold = True
 .Font.ColorIndex = 1
 End With
 
 





For Zeile = 8 + zeilex To ZeileMax


If Month(.Cells(Zeile, 1).Value) = monat Then



.Range("a" & Zeile, "i" & Zeile).Copy Destination:=Tabelle6.Rows(n)


n = n + 1

End If

If n = 52 Then
n = 57
kopf = 56
zeilex = 42
GoTo startdienst
End If

If n = 101 Then
n = 106
kopf = 105
zeilex = 86
GoTo startdienst
End If

Next Zeile

Tabelle6.Range("g" & n).Value = WorksheetFunction.Sum(Tabelle6.Range("g10", "g" & n))
Tabelle6.Range("h" & n).Value = WorksheetFunction.Sum(Tabelle6.Range("h10", "h" & n))
Tabelle6.Range("i" & n).Value = WorksheetFunction.Sum(Tabelle6.Range("i10", "i" & n))
'Tabelle6.Range("j" & n).Value = WorksheetFunction.Sum(Tabelle6.Range("j10", "j" & n))
Tabelle6.Range("g" & n, "g" & n + 1).BorderAround ColorIndex:=0, Weight:=xlThin
Tabelle6.Range("h" & n, "h" & n + 1).BorderAround ColorIndex:=0, Weight:=xlThin
Tabelle6.Range("i" & n, "i" & n + 1).BorderAround ColorIndex:=0, Weight:=xlThin
'Tabelle6.Range("j" & n, "j" & n + 1).BorderAround ColorIndex:=0, Weight:=xlThin
Tabelle6.Range("g" & n + 1, "i" & n + 1).NumberFormat = "0.00"
Tabelle6.Range("g" & n + 1).Value = Cells(n, 7) * 24
Tabelle6.Range("h" & n + 1).Value = Cells(n, 8) * 24
Tabelle6.Range("i" & n + 1).Value = Cells(n, 9) * 24
'Tabelle6.Range("j" & n + 1).Value = Cells(n, 10) * 24


Cells(n, 6) = "Summe"


End With
Dim DateiName As String
Dim Datei As String

'ActiveSheet.PageSetup.PrintArea = "a1:l" & Range("d65536").End(xlUp).Row + 2
'ActiveSheet.PageSetup.PrintArea = "a1:k" & Range("e65536").End(xlUp).Row + 2

DateiName1 = Cells(5, 2)
DateiName2 = Cells(6, 2)

Datei = DateiName1 & " Monat " & DateiName2 & ".pdf"

'Print ActiveSheet.PageSetup.PrintArea = "a1:j" & Range("e65536").End(xlUp).Row + 2
ActiveSheet.PageSetup.PrintArea = "a1:j" & n + 1


Columns("C:C").Select
    Selection.EntireColumn.Hidden = True

ActiveSheet.PageSetup.Orientation = xlPortrait

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Datei, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False, OpenAfterPublish:=True
Sheets("Dienst").Select

End Sub

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Problem mit einer Schleife und Auswerung
31.12.2021 09:01:02 Martin Krantz
NotSolved
31.12.2021 09:37:15 Mase
NotSolved
01.01.2022 08:38:59 Gast71649
NotSolved
31.12.2021 15:19:24 Gast95007
NotSolved
01.01.2022 08:47:55 Gast69906
NotSolved
01.01.2022 15:59:47 Gast94521
NotSolved
02.01.2022 12:52:19 Gast32722
NotSolved
02.01.2022 14:40:40 Gast79641
NotSolved