Thema Datum  Von Nutzer Rating
Antwort
30.12.2022 14:06:07 Oliver Ding
NotSolved
Blau Durch Einfügungen wandernde Zelle in Makro referenzieren
 30.12.2022 14:48:52 Oliver Ding
NotSolved
30.12.2022 16:45:35 Gast15772
NotSolved

Ansicht des Beitrags:
Von:
Oliver Ding		 Datum:
30.12.2022 14:48:52		 Views:
443		 Rating:
     
Antwort:
  Ja
Thema:
Durch Einfügungen wandernde Zelle in Makro referenzieren

Ich habe mal ChatGPT gefragt. Das schlägt mir folgendes vor:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Dim ws As Worksheet
Dim lastRow As Long
Dim rngToClear As Range
Dim rngToColor As Range
Dim rngFormula1 As Range
Dim rngFormula2 As Range
Dim rngDelete As Range
 
' Setze das aktive Tabellenblatt als das zu verarbeitende Tabellenblatt
Set ws = ActiveSheet
 
' Kopiere Zeile 2 und füge sie ein
ws.Rows(2).Copy
ws.Rows(3).Insert Shift:=xlDown
 
' Lösche Zellen A2 bis Q2
Set rngToClear = ws.Range("A2:Q2")
rngToClear.ClearContents
 
' Setze die Füllfarbe der Zellen A2 bis Q2 auf keine Füllung
Set rngToColor = ws.Range("A2:Q2")
rngToColor.Interior.Color = xlNone
 
' Finde die letzte belegte Zeile in Spalte R
lastRow = ws.Cells(ws.Rows.Count, "R").End(xlUp).Row
 
' Setze die Formel für die Summe in Spalte E unterhalb der letzten belegten Zeile in Spalte R
Set rngFormula1 = ws.Cells(lastRow + 1, "E")
rngFormula1.Formula = "=SUMME(R2:R" & lastRow & ")"
 
' Setze die Formel für die Summe in der Zeile unterhalb der Formel in Spalte E
Set rngFormula2 = ws.Cells(lastRow + 2, "E")
rngFormula2.Formula = "=SUMME(C2:C" & lastRow & ")"
 
' Setze die Zelle B2 als aktive Zelle
ws.Range("B2").Select


 

Das Script läuft allerdings beim zweiten Aufruf in Laufzeitfehler 1004, weil durch ws.Rows(ws.Rows.Count).Insert Shift:=xlDown dafür gesorgt wird, dass etwas über das Ende des Tabellenblatts hinaus eingeschoben werden würde. Dabei hatte ich genau dies nach dem ersten Fehler der Art schon als Anforderung mitübergeben. Ich hab dann gebeten, 14 Zeilen tiefer die komplette Zeile zu löschen, um Platz  zu schaffen ...
 

?
1
2
3
' Lösche die 14. Zeile unterhalb der letzten belegten Zeile in Spalte R
Set rngDelete = ws.Rows(lastRow + 14)
rngDelete.Delete Shift:=xlUp

Das hab ich vor dem Fokus auf Zelle B2 eingefügt. Der Fehler tritt weiter auf. 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
30.12.2022 14:06:07 Oliver Ding
NotSolved
Blau Durch Einfügungen wandernde Zelle in Makro referenzieren
 30.12.2022 14:48:52 Oliver Ding
NotSolved
30.12.2022 16:45:35 Gast15772
NotSolved