For Schleife variablen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Worksheet_Change(ByVal Target As Range) Dim LastPosR As Long, ZwischSum As Range, MyFormStr As String With ActiveSheet.Cells Set ZwischSum = .Find(what:="Zwischensumme:", LookIn:=xlValues, lookat:=xlWhole) If Not ZwischSum Is Nothing Then LastPosR = Range(Cells(ZwischSum.Row, 2).Address).End(xlUp).Row End If End With If Cells(LastPosR, 2).Address = Target.Address Then If Not Cells(LastPosR, 2) = "" Then With Application .ScreenUpdating = False .Application.EnableEvents = False MyFormStr = Cells(LastPosR, 6).FormulaR1C1 Cells(LastPosR, 2).Rows.EntireRow.Insert Range(Cells(LastPosR + 1, 1), Cells(LastPosR + 1, 6)).Copy Paste Range(Cells(LastPosR, 1), Cells(LastPosR, 6)) Range(Cells(LastPosR + 1, 2), Cells(LastPosR + 1, 5)).ClearContents Cells(LastPosR, 6).FormulaR1C1 = MyFormStr Cells(LastPosR + 1, 6).FormulaR1C1 = MyFormStr .Goto ActiveCell.Offset(-1, 0) .ScreenUpdating = True .Application.EnableEvents = True End With Else Rows(LastPosR + 2).Delete xlShiftUp End If End If End Sub

With ActiveSheet.Cells Set ZwischSum = .Find(what:="Zwischensumme:", LookIn:=xlValues, lookat:=xlWhole) 'Hier sucht sich das Makro die Zeile in der Zwischensumme steht und weist sie dem Range _ ZwischSum zu If Not ZwischSum Is Nothing Then 'Abfrage ob etwas zugewiesen wurde. LastPosR = Range(Cells(ZwischSum.Row, 2).Address).End(xlUp).Row 'wenn ZwischSum einen Wert hat dann weise LastPosR die Adresse mit der Zeilenwert _ von Zwischsum und den Spaltenwert von 2 zu End If End With

Hallo!
Das Kommando LastPosR = Range(Cells(ZwischSum.Row, 2).Address).End(xlUp).Row
Sucht Aufwaerts von der angegebenen Addresse bis es eine Zeile findet, in der etwas steht. Das ist dann die Zeilennummer, welche eingetragen wird. Falls Du da die naechste Zeile haben moechtes, einfach + 1 dazuaddieren, z.B. LastPosR = Range(Cells(ZwischSum.Row, 2).Address).End(xlUp).Row +1
Loeschen geht nicht, weil meinerseits fehlerhaft umgesetzt. Probier mal so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastPosR As Long, ZwischSum As Range, MyFormStr As String
With ActiveSheet.Cells
Set ZwischSum = .Find(what:="Zwischensumme:", LookIn:=xlValues, lookat:=xlWhole)
If Not ZwischSum Is Nothing Then
LastPosR = Range(Cells(ZwischSum.Row, 2).Address).End(xlUp).Row
End If
End With
If Cells(LastPosR, 2).Address = Target.Address Then
If Not Cells(LastPosR, 2) = "" Then
With Application
.ScreenUpdating = False
.Application.EnableEvents = False
MyFormStr = Cells(LastPosR, 6).FormulaR1C1
Cells(LastPosR, 2).Rows.EntireRow.Insert
Range(Cells(LastPosR + 1, 1), Cells(LastPosR + 1, 6)).Copy
Paste Range(Cells(LastPosR, 1), Cells(LastPosR, 6))
Range(Cells(LastPosR + 1, 2), Cells(LastPosR + 1, 5)).ClearContents
Cells(LastPosR, 6).FormulaR1C1 = MyFormStr
Cells(LastPosR + 1, 6).FormulaR1C1 = MyFormStr
.Goto ActiveCell.Offset(-1, 0)
.ScreenUpdating = True
.Application.EnableEvents = True
End With
End If
ElseIf LastPosR

Dabei bleibt aber die letzte Rechnungsposition immer als leere Zeile erhalten. Das koennte man ueber eine Rechnungsabschluss-Prozedur beheben.
Gruss
Dirk aus Dubai

Hallo Dirk,
ich habe es jetzt schon recht weit geschafft und habe es auch nach meinen Vorstellungen umgeschrieben und auch wieder eine Menge gelernt sodass, der Titel eigentlich hinfällig ist :D
man kann und sollte wahrscheinlich des öfteren ohne schleifen arbeiten, wo man gar keine braucht:D.
So nun zu meiner abschließenden Frage oder es sind genauer gesagt zwei...
https://www.herber.de/bbs/user/78542.xlsm
Ich habe es jetzt so umgeschrieben, dass eine Zeile erst kopiert wird wenn in die Vorletzte Zeile etwas hineingeschrieben wird.
Wenn ich dann diese neue Zeile habe, dann löst das Löschereignis natürlich aus , wenn in der vorletzten Zeile etwas passiert und durch die Prüfung in das else rein kommt....
Wie kann ich es umsetzten, dass es die letzte Zeile schon löscht, wenn ich in der drittletzten Zeile den Wert lösche?
Ich hoffe es war verständlich :D
Und dann noch eine Design-Frage: Jedesmal wenn ich Werte eingebe oder eine Zeile gelöscht wird, dann bleiben solch hässliche blaue Markierungen übrig... Wie kann ich die weg machen oder diese verhindern?
Mfg
Stephan

ElseIf Cells(LastPosR - 2, 2).Address = Target.Address Then If Cells(LastPosR - 2, 2) = "" Then If LastPosR >= 21 Then Application.EnableEvents = False Range(Cells(LastPosR, 1), Cells(LastPosR, 6)).Delete Application.EnableEvents = True

Beliebteste Forumthreads (12 Monate)

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread