Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Performance - Leere Zeilen

VBA - Performance - Leere Zeilen
15.11.2021 10:23:35
Nico
Hallo liebes Forum,
ich muss mich heute mal wieder mit einer Frage an euch wenden:
Ich habe in der Vergangenheit ein Makro gebaut, um eine große Excel auf monatlicher Basis in ein bestimmtes Format zu bringen und dann in verschiedene kleine Listen zu verteilen. Die Ausgangsliste kann dabei je nach Monat unterschiedlich viele Zeilen haben, jedoch stets den gleichen Aufbau.
Das erstellte Makro funktioniert inhaltlich auch einwandsfrei und nimmt die gewünschte Formatierung und Aufteilung vor.
Jedoch kopiert er bei jedem Blatt auch immer alle Leer-Zeilen (Also bis Zeile 1.048.576) mit, wodurch die Performance und die Speichergröße nicht hinnehmbar sind.
Eigentlich war der Plan, nur die Zeilen zu kopieren, wenn in Spalte A tatsächlich Werte oder Text stehen.
Hat hier jemand eine Idee, wo der Fehler liegt? Der Code hängt unten an.
Danke für eure Hilfe
Nico

Sub Formatierung_Test_Modul()
Dim Bereich As String
Dim Zelle As Range
Dim Tabelle As Worksheet
Dim Zeile As Long
Dim ZeileMax As Long
Dim rngFill As Range
Dim i As Long
Dim u As Long
Dim s As Integer
Dim r As Long
Dim pasteRowIndex As Long
Dim wksLast As Worksheet
'If ActiveWorkbook.Sheets.Count 

Sub Header()
Dim WS_Count As Integer
Dim i As Integer
Dim r As Integer
Worksheets("Testblatt").Select
WS_Count = ActiveWorkbook.Worksheets.Count
For r = 3 To WS_Count
With ActiveWorkbook.Worksheets(r)
'.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'.Range("B1").FormulaR1C1 = "=RIGHT(CELL(""dateiname"",RC[-1]),LEN(CELL(""dateiname"",RC[-1]))-FIND(""]"",CELL(""dateiname"",RC[-1])))"
'.Range("A:A").Replace _
'What:=Range("B1"), Replacement:="Buchung", _
'SearchOrder:=xlByColumns, MatchCase:=True
'.Rows("1:1").Delete Shift:=xlUp
Application.CutCopyMode = False
.Rows("1:12").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A1").FormulaR1C1 = "LUCANET"
.Range("A3").FormulaR1C1 = "Name"
.Range("A4").FormulaR1C1 = "Buchungskreis"
.Range("A5").FormulaR1C1 = "Datenebene"
.Range("A6").FormulaR1C1 = "Bewertungsebene"
.Range("A8").FormulaR1C1 = "Spaltendefinition"
.Range("A11").FormulaR1C1 = "Buchungsdatum"
.Range("B8").FormulaR1C1 = "Konto"
.Range("C8").FormulaR1C1 = "Bewegungsart"
.Range("D8").FormulaR1C1 = "Soll"
.Range("E8").FormulaR1C1 = "Haben"
.Range("D11").FormulaR1C1 = "=Testblatt!RC"
.Range("E11").FormulaR1C1 = "=Testblatt!RC"
.Range("F8").FormulaR1C1 = "Text"
.Range("B1").FormulaR1C1 = "=RIGHT(CELL(""dateiname"",RC[-1]),LEN(CELL(""dateiname"",RC[-1]))-FIND(""]"",CELL(""dateiname"",RC[-1])))"
.Range("B5").FormulaR1C1 = "Ist"
.Range("B6").FormulaR1C1 = "IFRS 16 - Laufende Buchungen"
.Range("B3").FormulaR1C1 = "=CONCATENATE(""IFRS 16 - "",R[-2]C,"" "",R[8]C[3])"
.Range("B4").FormulaR1C1 = "=VLOOKUP(R[-3]C,Stammdaten!R1C1:R23C2,2,0)"
.Range("D1").FormulaR1C1 = "=SUM(R[12]C:R[999995]C)"
.Range("E1").FormulaR1C1 = "=SUM(R[12]C:R[999995]C)"
.Columns("A:Z").EntireColumn.AutoFit
.Range("D1").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""?_);_(@_)"
.Range("E1").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""?_);_(@_)"
.Range("D13:D999999").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""?_);_(@_)"
.Range("E13:E999999").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""?_);_(@_)"
.Range("G13:G" & Cells(Rows.Count, 2).End(xlUp).Row).Copy
.Range("A13:A" & Cells(Rows.Count, 2).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("G:G").Delete Shift:=x1ToLeft
End With
Next r
End Sub

Sub WorksheetLoop()
Dim WS_Count As Integer
Dim i As Integer
Dim r As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For r = 3 To WS_Count
With ActiveWorkbook.Worksheets(r)
For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If .Cells(i, 1)  .Range("B1") Then .Rows(i).Delete
Next i
End With
Next r
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige