Formeln um eine Zeile runterziehen wenn
Guten Morgen,
abgesehen davon, dass in der Beispieldatei die Formel in M nichts anzeigt*, geht es mir um folgendes:
In Spalte A steht ein Datum, in M, N, O und R stehen Formeln.
Nun möchte ich erreichen, dass immer wenn in Spalte A ein neuer Datensatz eingegeben wird, die Formeln aus der Zeile darüber runtergezogen werden bzw wieder gelöscht wenn auch das Datum gelöscht wird.
Leider hatte ich mit VBA schon seit einigen Jahren nichts mehr zu tun, so dass mir jeder Lösungsansatz fehlt.
Viele Grüße Jokurt (Uwe)
*(Die Formel in M habe ich aus einem anderen Projekt übernommen, wo sie problemlos funktioniert, und aus meiner Sicht auch korrekt angepasst. Von dem Ergebnis hängt auch das korrekte Ergebnis in Spalte O und R ab)
abgesehen davon, dass in der Beispieldatei die Formel in M nichts anzeigt*, geht es mir um folgendes:
In Spalte A steht ein Datum, in M, N, O und R stehen Formeln.
Nun möchte ich erreichen, dass immer wenn in Spalte A ein neuer Datensatz eingegeben wird, die Formeln aus der Zeile darüber runtergezogen werden bzw wieder gelöscht wenn auch das Datum gelöscht wird.
Leider hatte ich mit VBA schon seit einigen Jahren nichts mehr zu tun, so dass mir jeder Lösungsansatz fehlt.
Viele Grüße Jokurt (Uwe)
*(Die Formel in M habe ich aus einem anderen Projekt übernommen, wo sie problemlos funktioniert, und aus meiner Sicht auch korrekt angepasst. Von dem Ergebnis hängt auch das korrekte Ergebnis in Spalte O und R ab)
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 82472075785
Url: https://administrator.de/forum/formeln-um-eine-zeile-runterziehen-wenn-82472075785.html
Ausgedruckt am: 26.12.2024 um 08:12 Uhr
12 Kommentare
Neuester Kommentar
Geht das?
In den Editor als neues Modul dann mit Strg+F11 usw ;)
Sub FormelnRunterziehen()
'Deklarationen
Dim Zeile As Long
Dim Zelle As Range
'Aktuelle Zeile ermitteln
Zeile = ActiveCell.Row
'Zelle in Zeile darüber ermitteln
Zelle = Cells(Zeile - 1, 1)
'Wenn Zelle nicht leer, Formeln runterziehen
If Zelle.Value <> "" Then
For Each Zelle In Range("A:D", Cells(Zeile, 1), Cells(Zeile, 1))
Zelle.Value = Cells(Zeile - 1, Zelle.Column).Value
Next Zelle
End If
End Sub
In den Editor als neues Modul dann mit Strg+F11 usw ;)
Hallo
Code nicht in ein Modul, sondern in das entsprechende Sheet einfügen (weil Event-Prozedur des Sheets benutzt wird).
Code wird automatisch ausgeführt sobald In Spalte A Eintragungen gemacht werden.
Ich hätte die Formeln allerdings einfach schon diverse Zellen runtergezogen und diese in ein WENNFEHLER() oder WENN() gekapselt und leeren Text anzeigen lassen wenn nichts in Zelle A steht, dann brauchst du auch kein Makro
Gruß Katrin
Code nicht in ein Modul, sondern in das entsprechende Sheet einfügen (weil Event-Prozedur des Sheets benutzt wird).
Code wird automatisch ausgeführt sobald In Spalte A Eintragungen gemacht werden.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim cell As Range, rng1 As Range, rng2 As Range
If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
Application.EnableEvents = False
For Each cell In Target
Set rng1 = Range(Cells(cell.Row, "M"), Cells(cell.Row, "O")).Offset(-1, 0)
Set rng2 = Cells(cell.Row, "R").Offset(-1, 0)
If cell.Value <> "" Then
Set rng1 = Range(Cells(cell.Row, "M"), Cells(cell.Row, "O")).Offset(-1, 0)
Set rng2 = Cells(cell.Row, "R").Offset(-1, 0)
rng1.AutoFill Destination:=rng1.Resize(2, rng1.Columns.Count), Type:=xlFillDefault
rng2.AutoFill Destination:=rng2.Resize(2, rng2.Columns.Count), Type:=xlFillDefault
Else
rng1.Clear
rng2.Clear
End If
Next
Application.EnableEvents = True
End If
End Sub
Ich hätte die Formeln allerdings einfach schon diverse Zellen runtergezogen und diese in ein WENNFEHLER() oder WENN() gekapselt und leeren Text anzeigen lassen wenn nichts in Zelle A steht, dann brauchst du auch kein Makro
Gruß Katrin
Leider werden schon beim reinkopieren die beiden Zeilen rot markiert
Ach herjehmineh, mein Fehler, habe ihn oben korrigiert, kommt davon wenn man PowerShell und VBA gleichzeitig schreibt 😀, die Dollarzeichen vor den Variablen gehören da natürlich nicht hin.
Hi nochmal.
Kannst Du diese Version einmal testen?
Kannst Du diese Version einmal testen?
Private Sub Worksheet_Change(ByVal Target As Range)
'Deklarationen
Dim Zeile As Long
Dim Zelle As Range
'Aktuelle Zeile ermitteln
Zeile = ActiveCell.Row
'Wenn Zelle in Spalte A nicht leer, Formeln runterziehen
If Cells(Zeile, 1).Value <> "" Then
For Each Zelle In Range(Cells(Zeile, "M"), Cells(Zeile + 1, "R"))
Zelle.Value = Cells(Zeile - 1, Zelle.Column).Value
Next Zelle
End If
End Sub
Zitat von @Jokurt:
@Katrin: Bei der Eingabe eines neuen TN (Spalte B) werden die Formeln in T:V korrekt runtergezogen, Y leider nicht.
Lösche ich in B den TN Namen, werden in der darüberliegenden Zeile in T:V und Y die Einträge gelöscht, nicht aber die komplette Zeile in der ich den Namen gelöscht habe.
Vielleicht mag jemand nochmal drüber schauen.
@Katrin: Bei der Eingabe eines neuen TN (Spalte B) werden die Formeln in T:V korrekt runtergezogen, Y leider nicht.
Lösche ich in B den TN Namen, werden in der darüberliegenden Zeile in T:V und Y die Einträge gelöscht, nicht aber die komplette Zeile in der ich den Namen gelöscht habe.
Vielleicht mag jemand nochmal drüber schauen.
Tja, kein Wunder , ich zitiere dich aus der Frage
In Spalte A steht ein Datum, in M, N, O und R stehen Formeln.
Nun möchte ich erreichen, dass immer wenn in Spalte A ein neuer Datensatz eingegeben wird, die Formeln aus der Zeile darüber runtergezogen werden bzw wieder gelöscht wenn auch das Datum gelöscht wird.
Nun möchte ich erreichen, dass immer wenn in Spalte A ein neuer Datensatz eingegeben wird, die Formeln aus der Zeile darüber runtergezogen werden bzw wieder gelöscht wenn auch das Datum gelöscht wird.
Genau darauf wurde der Code kreiert, klappt hier auch im Test wie gewünsch. Du hast es wohl selbst falsch angepasst.
Code lesen und verstehen und erst dann selbst für deine Zwecke anpassen, sonst hast du von der ganzen Sache rein gar nichts gelernt! Und wer will sich schon von einem Forum abhängig machen ...?! It's your work, not ours. We delivered the template, you do the rest! So start using the round thing on your neck, this is not a "make me my work" service 👋