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

Code erweitern

Forumthread: Code erweitern

Code erweitern
28.01.2025 10:38:00
JR2025
Hallo,

ich habe den folgenden Code gefunden allesdings scheitert es an meinen Kenntnissen bei der Anpassung.
Der Code fügt bei jedem geänderten Eintrag in Spalte3 eine neue Zeile ein
Die Ausführung erfolgt zum Monatsende durch Betätigung eines Button

Bis dahin funktioniert das super.

Jetzt wollte ich aber die eingefügten Formeln zusammenrechnen und die neu eingefügten Zeilen farbig markieren.
Meine Idee war mit dem einfügen der neuen Zeile zusätzlich in Spalte 23 eine 1 einzufügen, die ich für eine Bed. Formatieung und zum erstellen einer Formel für den Monatsabschluß verwenden kann.

Sub Leerzeile()

Dim ErsteZeile As Long, LetzteZeile As Long, Spalte As Long, i As Long
Dim rng As Range
ErsteZeile = 5
LetzteZeile = 2000
Spalte = 3
For i = LetzteZeile To ErsteZeile Step -1
If Cells(i, Spalte) > Cells(i - 1, Spalte) Then Rows(i).Insert (xlShiftDown)
Next i
For Each rng In Columns(14).SpecialCells(xlCellTypeConstants).Areas
rng(rng.Rows.Count + 1).Formula = "=sum(" & rng.Address & ")"
Next
For Each rng In Columns(23).SpecialCells(xlCellTypeConstants).Areas
rng(rng.Rows.Count + 1).Value = "1" ' war eine idee von mir
Next
End Sub


So wie ich mir gedacht habe geht es aber nicht.
Hat jemand einen Tipp wie sich das umsetzen lässt.

Danke
bis später
Jörg
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code erweitern
28.01.2025 10:49:11
Yal
Hallo Jörg,

es ist fast wie eine Morgengymnastik.

Sub Leerzeile()

Dim i As Long
Dim rng As Range
Const ErsteZeile = 5
Const LetzteZeile = 2000
Const Spalte = 3

For i = LetzteZeile To ErsteZeile Step -1
If Cells(i, Spalte) > Cells(i - 1, Spalte) Then
Rows(i).Insert (xlShiftDown)
Cells(i + 1, 23).Value = 1 'füge einen 1 in Spalte 23 der neuen Zeile
End If
Next i
For Each rng In Columns(14).SpecialCells(xlCellTypeConstants).Areas
rng(rng.Rows.Count + 1).Formula = "=sum(" & rng.Address & ")"
Next
End Sub
Werte, die sich während der Ausführung nicht ändern, kann man als Kontante definieren. Sieht dann schlanker aus.
Achte, zwecks Lesbarkeit, auf einem sauberen Einrücken.

VG
Yal
Anzeige
AW: Code erweitern
28.01.2025 10:57:24
UweD
Hallo

so?

Sub Leerzeile()

Dim ErsteZeile As Long, LetzteZeile As Long, Spalte As Long, i As Long
Dim rng As Range
ErsteZeile = 5
LetzteZeile = 2000
Spalte = 3
For i = LetzteZeile To ErsteZeile Step -1
If Cells(i, Spalte) > Cells(i - 1, Spalte) Then
Rows(i).Insert (xlShiftDown)
Cells(i, 23) = 1
End If
Next i
For Each rng In Columns(14).SpecialCells(xlCellTypeConstants).Areas
rng(rng.Rows.Count + 1).Formula = "=sum(" & rng.Address & ")"
Next
End Sub



LG UweD
Anzeige
Korrektur von Korrektur
28.01.2025 11:09:01
Yal
Uwe hat recht: wenn vor Zeile i eine Zeile eingefügt wird, dann ist die ehemalige "i" jetzt "i + 1" und die neue die "i".
(nicht ganz gut aufgewacht heute :-(

Es ist zwar nicht falsch i mit i - 1 zu vergleichen, aber besser wäre i mit i + 1 zu vergleichen und bei Ungleichheit eine Zeile vor i + 1 einzuführen. Dann wäre i immer die gerade betrachtete Zeile (und nicht auf einmal die neue, wie hier oben).

VG
Yal
Anzeige
AW: Code erweitern
28.01.2025 11:10:22
JR2025
Hallo Uwe,

danke für die schnelle Antwort, funktioniert super.

Wenn man den Code sieht ist das ganz einfach, da währe ich aber nie draufgekommen.

bis zum nächsten mal
Jörg
AW: Code erweitern
28.01.2025 11:14:33
JR2025
Hallo Yal,

danke für die schnelle Antwort.

super

bis zum nächsten mal
Jörg
Anzeige
Korrektur
28.01.2025 10:51:49
Yal
die neue Zeile ist natürlich in i - 1 und nicht in i + 1 zu finden.

Sub Leerzeile()

Dim i As Long
Dim rng As Range
Const ErsteZeile = 5
Const LetzteZeile = 2000
Const Spalte = 3

For i = LetzteZeile To ErsteZeile Step -1
If Cells(i, Spalte) > Cells(i - 1, Spalte) Then
Rows(i).Insert (xlShiftDown)
Cells(i - 1, 23).Value = 1 'füge einen 1 in Spalte 23 der neuen Zeile
End If
Next i
For Each rng In Columns(14).SpecialCells(xlCellTypeConstants).Areas
rng(rng.Rows.Count + 1).Formula = "=sum(" & rng.Address & ")"
Next
End Sub

VG
Yal
Anzeige

Forumthreads zu verwandten Themen

Anzeige
Anzeige