Optimierung Makro - Teil 2 | HERBERS Excel Forum

Hallo,‎
ich habe letzte Woche schon um Eure Hilfe gebeten, um mein Makro noch weiter zu ‎optimieren. (Beitrag-ID:‎1628410‎ ‎2018-06-12 15:25:31‎)
Daniel hat mir da ein tolles Makro geschrieben, das superschnell funktioniert (das ich ‎aber leider nur bruchstückhaft verstehe :-(.‎
Jetzt müßte noch eine Kleinigkeit abgeändert werden und ich weiß leider nicht wie. Makro siehe ganz unten.
‎
Makro soll folgendes tun:
‎1. Wenn in Spalte G leere Zellen gibt, dann die ganze Zeile löschen (Makro macht es!)‎
‎
‎2. Wenn in Spalte G ein Betrag steht, aber in Spalte A in der dazu gehörigen Zeile ‎nichts steht, dann sollen die Daten von der vorherigen Zeile aus der Spalte A-D reinko‎piert werden (Makro macht es, aber nur mit einer Zeile!)‎
ERGÄNZUNG zu 2): Solange die vorherigen Zeilen aus der Spalte A-D reinkopieren, bis in ‎Spalte A wieder etwas steht - sprich nicht mehr Null ist (Makro macht es leider nicht). ‎
Beispiel:‎
A2 500 B2100 C2.‎ G2 200‎
‎ ‎ ‎ G3 100‎
G4 100‎
G5 40
A6 400 B6 300 C6.‎ G6 800‎
gewünschtes Ergebnis:‎
A2 500 B2100 C2.‎ G2 200‎
A3 500 B3100 C3. G3 100‎
A4 500 B4100 C4.‎ G4 100‎
A5 500 B5100 C5.‎ G5 40‎
A6 400 B6 300 C6.‎ G6 800‎
‎
Außerdem würde ich mich freuen, wenn jemand sich Zeit nimmt und mir das untere Makro ‎von Daniel erklärt, was es genau macht .damit ich es besser verstehen kann und zukünftig ‎selbst Änderungen eingeben kann.‎
Speziell habe ich folgende Fragen:‎
a)‎ Mit UsedRange wird das ganze Blatt (=alle Zellen) angesprochen, oder?‎
b)‎ Was bedeuted Punkt vor dem Columns oder Value (wann nimmt man es her? ‎Z.B. with . columns
c)‎ Zeile 4 verstehe ich gar nicht: FormulaR1C1 = "=IF(RC7="""",1,"""")"‎
d)‎ Zeile 7 verstehe ich gar nicht: ‎
‎.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
e)‎ Folgende Zeile verstehe ich nicht ganz:‎
‎ With .Columns(.Columns.Count + 1).Resize(.Rows.Count - 1, ‎‎4).Offset(1, 0)‎
‎ .Select‎
‎ .FormulaR1C1 = "=IF(RC1="""",R[-1]C[" & 1 - .Column & "],RC[" & 1 ‎‎- .Column & "])"‎
f)‎
Vielen Dank im Voraus für Eure Hilfe!!‎

Sub xxx()‎
With ActiveSheet.UsedRange
‎    With .Columns(.Columns.Count + 1)‎
‎        .FormulaR1C1 = "=IF(RC7="""",1,"""")"‎
‎        .Formula = .Value‎
‎        .Cells(1, 1).ClearContents‎
‎        .EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
‎        If .Cells(2, 1).Value = 1 Then .SpecialCells(xlCellTypeConstants, ‎‎ _
1).EntireRow.Delete‎
‎        .ClearContents‎
‎    End With
End With
With ActiveSheet.UsedRange
‎    With .Columns(.Columns.Count + 1).Resize(.Rows.Count - 1, 4).Offset(1, 0)‎
‎        .Select‎
‎        .FormulaR1C1 = "=IF(RC1="""",R[-1]C[" & 1 - .Column & "],RC[" & 1 - ‎ _
8206;.Column & "])"‎
‎        .Copy‎
‎        .Offset(0, 1 - .Column).PasteSpecial xlPasteValues‎
‎        .ClearContents
‎    End With
End With
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
a) die Usedrange ist der Zellbereich, der alle verwendeten Zellen auf dem Blatt enthält, dh alle Zellen, die einen Wert, eine Formel oder eine Formatierung enthalten
b) die WITH-Klammer ist eine Komfort-Funktion, die Schreibarbeit spart.
in der Ziele mit WITH wird ein Objekt beschrieben, z.B. ein Zellbereich
in der Folge kann man dann, wenn man genau dieses Objekt verwenden will, einfach nur den Punkt schreiben und VBA setzt das WITH-Objekt dann davor.
macht man, wenn man öfters das gleiche Objekt verwendet.
Beispiel:

Sheets("Tabelle1").Cells(1, 1).Value = 1
Sheets("Tabelle1").Cells(2, 1).Value = 2
With Sheets("Tabelle1")
.Cells(1, 1).Value = 1
.Cells(2, 1).Value = 2
End with

c) das schreibt einfach nur die Formel =Wenn($G2="";1;"") in die letzte Spalte.
Damit werden alle Zeilen, die gelöscht werden sollen, mit 1 gekennzeichnet und die anderen Zellen bleiben leer.
Über diese Kennzeichnung kann diese Zellen dann leichter für die weiter Bearbeitung markieren
d) da wird einfach nur umsortiert, so dass alle Zeilen die gelöscht werden sollen, direkt untereinander stehen. Das löschen geht dann schneller.
e) da werden die ersten 4 Spalten per Formel ans Tabellenende kopiert und hierbei auch gleich die Ergänzungen gemacht um die Leerzellen zu füllen.
am besten ist, du gehst den Code mal im Einzelstepmodus durch und schaust dir parallel dazu an, was nach jedem Programmschritt in der Datei passiert ist.
Dann siehst du auch die Formeln und verstehst besser, was passiert.
Gruß Daniel

Sub xxx() Dim lr As Long, r As Long With ActiveSheet.UsedRange With .Columns(.Columns.Count + 1) .FormulaR1C1 = "=IF(RC7="""",1,"""")" .Formula = .Value .Cells(1, 1).ClearContents .EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes If .Cells(2, 1).Value = 1 Then .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete .ClearContents End With End With lr = Cells(Rows.Count, 7).End(xlUp).Row For r = 3 To lr If Cells(r, 1) = "" Then Cells(r, 1) = Cells(r - 1, 1) Cells(r, 2) = Cells(r - 1, 2) Cells(r, 3) = Cells(r - 1, 3) Cells(r, 4) = Cells(r - 1, 4) End If Next End Sub

Sub xxx() With ActiveSheet.UsedRange With .Columns(.Columns.Count + 1) .FormulaR1C1 = "=IF(RC7="""",1,"""")" .Formula = .Value .Cells(1, 1).ClearContents .EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes If .Cells(2, 1).Value = 1 Then .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete .ClearContents End With End With With ActiveSheet.UsedRange With .Columns(.Columns.Count + 1).Resize(.Rows.Count - 1, 4).Offset(1, 0) .FormulaR1C1 = "=IF(RC1="""",R[-1]C,RC[" & 1 - .Column & "])" .Copy .Offset(0, 1 - .Column).PasteSpecial xlPasteValues .ClearContents End With End With End Sub

Beliebteste Forumthreads (12 Monate)

Optimierung Makro - Teil 2

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread