Thema Datum  Von Nutzer Rating
Antwort
24.11.2019 10:55:31 starfrench
NotSolved
24.11.2019 11:45:15 Werner
NotSolved
24.11.2019 12:35:39 Gast52443
NotSolved
Blau Autifillfunktion im Makro
24.11.2019 14:49:12 Werner
NotSolved
24.11.2019 15:26:55 starfrench
NotSolved
24.11.2019 15:47:26 Gast59403
NotSolved
24.11.2019 16:18:03 Werner
NotSolved
24.11.2019 16:33:45 starfrench
NotSolved
25.11.2019 17:41:37 starfrench
NotSolved

Ansicht des Beitrags:
Von:
Werner
Datum:
24.11.2019 14:49:12
Views:
500
Rating: Antwort:
  Ja
Thema:
Autifillfunktion im Makro

Hallo,

teste mal:

Sub SBZ()

Application.ScreenUpdating = False
Range("B2").Select
ActiveWindow.FreezePanes = True
Range("B:B,F:F,H:H").NumberFormat = "dd/mm/yy;@"
Range("C:C,G:G,I:I").NumberFormat = "h:mm:ss;@"
Columns("L:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormulaR1C1 = "=(RC[-4]+RC[-3]-(RC[-6]+RC[-5]))*24*60"
Columns("L:L").NumberFormat = "General"
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=30"
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Count).SetFirstPriority
With Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 255
    .TintAndShade = 0
End With
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).StopIfTrue = False
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=30"
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Count).SetFirstPriority
With Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 5296274
    .TintAndShade = 0
End With
Range("L2:L" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).StopIfTrue = False
Range("L1") = "Arb.Zeit"
Range("M1") = "SBZ Zeit"
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormulaR1C1 = "=(RC[-5]+RC[-4]-(RC[-11]+RC[-10]))*24*60"
Columns("M:M").NumberFormat = "General"
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=240"
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Count).SetFirstPriority
With Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 255
    .TintAndShade = 0
End With
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).StopIfTrue = False
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=240"
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions.Count).SetFirstPriority
With Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 5296274
    .TintAndShade = 0
End With
Range("M2:M" & Cells(Rows.Count, "B").End(xlUp).Row).FormatConditions(1).StopIfTrue = False
Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Cells.Borders(xlDiagonalUp).LineStyle = xlNone
With Cells.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Cells.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Cells.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Cells.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Cells.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Cells.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
End Sub

 

Die letzte belegte Zeile ermittle ich in Spalte B. Bis dort wirkt sich dann der Code entsprechend aus. Spalte B dafür nicht passt, müsstest du den Code entsprechend anpassen.

Deine bedingten Formatierungen habe ich auch auf diesen Bereich angepasst. Die wirken sich somit nicht auf die ganze Spalte aus.

Dann noch eine Frage: Willst du tatsächlich die Rahmen um sämtliche Zellen des ganzen Blattes haben, oder nur auf den eigentlichen Datenbereich?

 

Gruß Werner


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
24.11.2019 10:55:31 starfrench
NotSolved
24.11.2019 11:45:15 Werner
NotSolved
24.11.2019 12:35:39 Gast52443
NotSolved
Blau Autifillfunktion im Makro
24.11.2019 14:49:12 Werner
NotSolved
24.11.2019 15:26:55 starfrench
NotSolved
24.11.2019 15:47:26 Gast59403
NotSolved
24.11.2019 16:18:03 Werner
NotSolved
24.11.2019 16:33:45 starfrench
NotSolved
25.11.2019 17:41:37 starfrench
NotSolved