Makro vereinfachen
01.08.2019 15:27:47
Jenny
ich habe mir unten stehendes Makro aufgezeichnet, bin natürlich neugierig, wie es vernünftig programmiert aussähe.
Habe schonmal alles, was mit ScrollRow zu tun hat gelöscht. Hoffe jetzt ich habe nicht zuviel gelöscht:
Danke für eure Hilfe
Jenny
Kurze Erklärung, was es tun soll:
1. Die 4 Texte in F4:F7 transponiert in A1:D1 einfügen.
2. vor jeden der 4 Texte ein = einfügen, damit eine Formel daraus wird.
3. Die 4 Formeln bis zur Zeile 365 kopieren und Werte einfügen.
4. Im Bereich A1:D365 alle Rahmenlinien einfügen
5. in Spalte A sind die Daten von heute an, aufgelistet, sprich (heute) A1=1.8.19 bis A365=30.7.2020, den Bereich von Zeile 1 bis Ende des Folgemonats ausdrucken (nur Spalten A bis D), zur Zeit sind das 61 Tage bis Ende September, daher steht im Makro A1:D61, mit der Skalierung "Alle Zeilen auf einer Seite darstellen".
Sub Makro1()
' Makro1 Makro
' Tastenkombination: Strg+y
Range("F4:F7").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=TODAY()+ROW()-1"
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Tabelle1!R1C[-1]:INDEX(Tabelle1!C[-1],R1C[3]),RANK(Tabelle1!RC[2],INDEX( _
Tabelle1!C[2],TRUNC((ROW(Tabelle1!RC[-1])-1)/R1C[3])*R1C[3]+1):INDEX(Tabelle1!C[2],TRUNC((ROW(Tabelle1!RC[-1])-1)/R1C[3])*R1C[3]+R1C[3])))"
Range("C1").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Tabelle1!R1C[-1]:INDEX(Tabelle1!C[-1],R2C[2]),RANK(Tabelle1!RC[2],INDEX( _
Tabelle1!C[2],TRUNC((ROW(Tabelle1!RC[-2])-1)/R2C[2])*R2C[2]+1):INDEX(Tabelle1!C[2],TRUNC((ROW(Tabelle1!RC[-2])-1)/R2C[2])*R2C[2]+R2C[2])))"
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Tabelle1!R1C[-1]:INDEX(Tabelle1!C[-1],R3C[1]),RANK(Tabelle1!RC[2],INDEX( _
Tabelle1!C[2],TRUNC((ROW(Tabelle1!RC[-3])-1)/R3C[1])*R3C[1]+1):INDEX(Tabelle1!C[2],TRUNC((ROW(Tabelle1!RC[-3])-1)/R3C[1])*R3C[1]+R3C[1])))"
Range("A1:D1").Select
Selection.Copy
Range("A1:D365").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Range("A1:D365").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select
ActiveWindow.SmallScroll Down:=36
Range("A1:D61").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub