AW: Autofill / Inhalt übernehmen
09.06.2010 12:49:39
Hajo_Zi
Hallo Jo,
das ist mir zu aufwendig mich da durchzuarbeiten. Ich habe hier auch nicht Version 2007.
Auf select kann in VBA verzichtet werden zu 99,9%. Die Befehle für 2007 habe ich mal auskommentierrt.
Sub Grandt()
With Cells.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
' .TintAndShade = 0
' .ThemeFont = xlThemeFontNone
End With
Cells.EntireColumn.AutoFit
Columns("I:I").Cut
Columns("B:B").Insert Shift:=xlToRight
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Tabelle1").Name = "Tarifübersicht"
With Range("A1")
.Value = "Lager"
With .Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
' .TintAndShade = 0
' .ThemeFont = xlThemeFontNone
End With
End With
Range("B1") = "13.43"
Columns("B:B").NumberFormat = "#,##0.00 $"
With Range("A2")
.Value = "Laborant"
With .Characters(Start:=1, Length:=8).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
' .TintAndShade = 0
' .ThemeFont = xlThemeFontNone
End With
End With
Range("B2") = "18"
With Range("A3")
.Value = "Fachhilfskraft Labor"
With .Characters(Start:=1, Length:=20).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
' .TintAndShade = 0
' .ThemeFont = xlThemeFontNone
End With
End With
Range("B3") = "15.25"
Range("A2") = "Sachberarbeiter"
Range("B2") = "24.9"
Columns("A:A").EntireColumn.AutoFit
With Sheets("Buchungsübersicht")
.Range("O2").FormulaR1C1 = _
"=IF(RC[-14]="""","""",VLOOKUP(LEFT(RC[-11],5)&""*"",Tarifübersicht!C[-14]:C[-13],2, _
FALSE))"
.Range("O2").AutoFill .Range("O2:O" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range("O1") = "Tarif"
.Range("P1") = "Tarif * h"
.Range("Q1") = "Nacht"
.Range("R1") = "Samstag"
.Range("S1") = "Sonntag"
.Range("T1") = "Mehrarbeit"
.Range("U1") = "Gesamt"
With .Range("O1:U1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent4
' .TintAndShade = 0.599993896298105
' .PatternTintAndShade = 0
End With
.Columns("O:U").NumberFormat = "#,##0.00 $"
.Range("P2").FormulaR1C1 = "=RC[-1]*RC[-8]"
.Range("p2").AutoFill .Range("p2:p" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range("R2").FormulaR1C1 = "=IF(RC[-7]="""",0,RC[-7]*(RC[-3]*0.25))"
.Range("r2").AutoFill .Range("r2:r" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range("S2").FormulaR1C1 = "=IF(RC[-7]="""",0,RC[-7]*(RC[-4]*0.25))"
.Range("s2").AutoFill .Range("s2:s" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range("Q2").FormulaR1C1 = "=IF(RC[-7]=0,0,RC[-7]*(RC[-2]*0.25))"
.Range("q2").AutoFill .Range("q2:q" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range("T2") = ""
.Range("U2").FormulaR1C1 = "=RC[-5]+RC[-4]+RC[-3]+RC[-2]+RC[-1]"
.Range("u2").AutoFill .Range("u2:u" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Cells.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(8, 10, 11, _
12, 13, 17, 18, 19, 20, 21), Replace:=True, PageBreaks:=False, SummaryBelowData _
:=True
.Columns("D:G").Columns.Group
.Cells.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(8, 10, 11, _
12, 13, 17, 18, 19, 20, 21), Replace:=True, PageBreaks:=False, SummaryBelowData _
:=True
.Columns("D:G").Columns.Group
Sheets.Add After:=Sheets(Sheets.Count)
.Columns("A:U").Copy Range("A1")
End With
With Sheets("Tabelle2")
.Name = "Mehrarbeit"
' .Cells.RemoveSubtotal
With .Columns("M:M")
.Delete Shift:=xlToLeft
' .Delete Shift:=xlToLeft
End With
.Columns("N:S").Delete Shift:=xlToLeft
.Range("N2").FormulaR1C1 = "=IF(RC[-6]>8,(RC[-6]-8)*RC[-1]*0.25,"""")"
.Range("N1").FormulaR1C1 = "Mehrarbeit"
.Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
With .Range("O1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent4
' .TintAndShade = 0.599993896298105
' .PatternTintAndShade = 0
End With
.Range("N1").FormulaR1C1 = "> 8h"
.Range("N2").FormulaR1C1 = "=IF(RC[-6]>8,RC[-6]-8,"""")"
.Columns("N:N").EntireColumn.AutoFit
.Columns("O:O").NumberFormat = "#,##0.00 $"
.Columns("F:G").EntireColumn.Hidden = True
.Columns("C:D").EntireColumn.Hidden = True
.Columns("I:I").EntireColumn.Hidden = True
.Range("n2").AutoFill .Range("n2:n" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Range("O2").AutoFill .Range("O2:O" & .Cells(.Rows.Count, "A").End(xlUp).Row)
With .Range("O2").CurrentRegion
.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
.Columns("N:N").NumberFormat = "#,##0.00"
With .Columns("O:O").Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
' .TintAndShade = 0
' .ThemeFont = xlThemeFontNone
End With
.Columns("O:O").EntireColumn.AutoFit
.Columns("N:N").EntireColumn.AutoFit
.Range("a:a").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
End With
End Sub
Gruß Hajo