Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code vereinfachen

Forumthread: Code vereinfachen

Code vereinfachen
Holger
Guten Morgen,
ich praktiziere grad "learning by doing". Deswegen würde ich gerne den unten stehenden Code vereinfachen. Besonders den untere (kursiven) Teil.

Sub Zinszahlungen_lfd_Jahr()
Dim ZZ$, Inv$
ZZ = "Zinszahlungen lfd. Jahr"
Inv = "Inventar"
Sheets(ZZ).Unprotect
Range("A14:Z120").Clear
With Sheets(Inv)
.Range("p1").Copy Sheets(ZZ).Range("l1")
.Range("A10:AM102").AutoFilter Field:=2, Criteria1:=""
.Range("A15:F110").Copy Sheets(ZZ).Range("A14")
.Range("T15:U110").Copy Sheets(ZZ).Range("G14")
.Range("z15:Ac110").Copy Sheets(ZZ).Range("I14")
.Range("A8").AutoFilter
End With
With Sheets(ZZ).Range("N14").Select
ActiveCell.FormulaR1C1 = "=DATE(YEAR(R1C12),MONTH(RC[-4]),DAY(RC[-4]))"
Selection.AutoFill Destination:=Range("N14:N50"), Type:=xlFillDefault
End With
With Sheets(ZZ).Range("O14").Select
ActiveCell.FormulaR1C1 = "=IF(YEAR(RC[-1])=YEAR(R1C12),RC[-1],"""")"
Selection.AutoFill Destination:=Range("O14:O50"), Type:=xlFillDefault
End With
With Sheets(ZZ).Range("P14").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-1]),"""",RC[-1])"
Selection.AutoFill Destination:=Range("P14:P50"), Type:=xlFillDefault
End With
    Sheets(ZZ).Range("P14:P50").Copy
Range("J14").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("a14:L50").Sort Key1:=Range("J14"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("J14:J50").Font.Bold = True
Range("J14:J50").NumberFormat = "dd/mm/"
Range("L14:L50").Font.Bold = True
Range("N14:Q51").Clear
ActiveWindow.SmallScroll ToRight:=-5
Range("L1").Select
ActiveSheet.Protect
End Sub

Mag mir jemand helfen?
Schöne Grüße
Holger
Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Code vereinfachen
18.05.2010 10:19:11
Hajo_Zi
Hallo Holger,
Option Explicit
Sub Zinszahlungen_lfd_Jahr()
Dim ZZ$, Inv$
ZZ = "Zinszahlungen lfd. Jahr"
Inv = "Inventar"
Sheets(ZZ).Unprotect
Range("A14:Z120").Clear
With Sheets(Inv)
.Range("p1").Copy Sheets(ZZ).Range("l1")
.Range("A10:AM102").AutoFilter Field:=2, Criteria1:=""
.Range("A15:F110").Copy Sheets(ZZ).Range("A14")
.Range("T15:U110").Copy Sheets(ZZ).Range("G14")
.Range("z15:Ac110").Copy Sheets(ZZ).Range("I14")
.Range("A8").AutoFilter
End With
With Sheets(ZZ)
With .Range("N14")
.FormulaR1C1 = "=DATE(YEAR(R1C12),MONTH(RC[-4]),DAY(RC[-4]))"
.AutoFill Destination:=Range("N14:N50"), Type:=xlFillDefault
End With
With .Range("O14")
.FormulaR1C1 = "=IF(YEAR(RC[-1])=YEAR(R1C12),RC[-1],"""")"
.AutoFill Destination:=Range("O14:O50"), Type:=xlFillDefault
End With
With .Range("P14")
.FormulaR1C1 = "=IF(ISERROR(RC[-1]),"""",RC[-1])"
.AutoFill Destination:=Range("P14:P50"), Type:=xlFillDefault
End With
.Range("P14:P50").Copy
Range("J14").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
Range("a14:L50").Sort Key1:=Range("J14"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("J14:J50").Font.Bold = True
Range("J14:J50").NumberFormat = "dd/mm/"
Range("L14:L50").Font.Bold = True
Range("N14:Q51").Clear
ActiveSheet.Protect
End Sub


Anzeige
AW: Code vereinfachen
18.05.2010 10:54:43
Holger
Danke Hajo,
jetzt kapiere ich auch verschachtelte "With" Anweisungen. Aber kann ich dann nicht alles passende in die "With" Anweisung stecken (so wie in meinen unten stehenden Code)? Oder hat das irgendwelche Nachteile?
Sub Zinszahlungen_lfd_Jahr()
Dim ZZ$, Inv$
ZZ = "Zinszahlungen lfd. Jahr"
Inv = "Inventar"
Sheets(ZZ).Unprotect
Range("A14:Z120").Clear
With Sheets(Inv)
.Range("p1").Copy Sheets(ZZ).Range("l1")
.Range("A10:AM102").AutoFilter Field:=2, Criteria1:=""
.Range("A15:F110").Copy Sheets(ZZ).Range("A14")
.Range("T15:U110").Copy Sheets(ZZ).Range("G14")
.Range("z15:Ac110").Copy Sheets(ZZ).Range("I14")
.Range("A8").AutoFilter
End With
With Sheets(ZZ)
With .Range("N14")
.FormulaR1C1 = "=DATE(YEAR(R1C12),MONTH(RC[-4]),DAY(RC[-4]))"
.AutoFill Destination:=Range("N14:N50"), Type:=xlFillDefault
End With
With .Range("O14")
.FormulaR1C1 = "=IF(YEAR(RC[-1])=YEAR(R1C12),RC[-1],"""")"
.AutoFill Destination:=Range("O14:O50"), Type:=xlFillDefault
End With
With .Range("P14")
.FormulaR1C1 = "=IF(ISERROR(RC[-1]),"""",RC[-1])"
.AutoFill Destination:=Range("P14:P50"), Type:=xlFillDefault
End With
.Range("P14:P50").Copy
Range("J14").PasteSpecial Paste:=xlValues
With Range("a14:L50")
.Sort Key1:=Range("J14"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
With Range("J14:J50")
.Font.Bold = True
.NumberFormat = "dd/mm/"
End With
Range("L14:L50").Font.Bold = True
Range("N14:Q51").Clear
Range("L1").Select
.Protect
End With
End Sub
Schönen Gruß
Holger
Anzeige
AW: Code vereinfachen
18.05.2010 10:59:35
Hajo_Zi
Hallo Holger,
in Deinem Code fehlt
Application.CutCopyMode = False
da Du einmal nur Werte kopierst. Zum Ablauf kann ich nichts schreiben.
Ich habe auch keine Ahnung auf welche Tabelle sich das erste Range bezieht.
Gruß Hajo
Anzeige
Ok, Danke!
18.05.2010 11:10:39
Holger
- owT -
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige