Range("G:G").insert
with activesheet.usedrange.columns("G")
.formulalocal = "=H1&"-"&Aufrunden(Zeile()/3000;0)"
.formula = .value
end with
Range("H:H").delete
Gruß, Daniel
ps. nicht getestet
Sub zahlen()
Dim zeile As Long
Dim zähler As Double
Dim reihe As Long
If Range("A65536") "" Then ' letzte Zeile ermitteln
reihe = 65536
Else
reihe = Range("A65536").End(xlUp).Row
End If
zähler = 1
For zeile = 3000 To reihe Step 3000 ' alle 3000 in der Hilfsspalte eine um 1 erhöhte Zahl einfü _
hren, z.B.: -1 , dann -2
Cells(zeile, 256).Value = "-" & zähler
zähler = zähler + 1
Next zeile
Dim zeile1 As Long
For zeile1 = 3000 To reihe ' Auffüllen der leeren zellen in der Hilfsspalte
If Cells(zeile1, 256).Value = "" Then
Cells(zeile1, 256).Value = Cells(zeile1 - 1, 256).Value
End If
Next zeile1
Dim reihe1
If Range("IV65536") "" Then
reihe1 = 65536
Else
reihe1 = Range("IV65536").End(xlUp).Row
End If
Range("IV" & reihe1).Copy Range("IV" & reihe1 + 1 & ":IV" & reihe) ' Auffüllen des Restes in _
der Hilfsspalte
Dim zeile2 As Long
For zeile2 = 3000 To reihe ' Zusammenfügen der Werte
Cells(zeile2, 7).Value = Cells(zeile2, 7).Value & Cells(zeile2, 256).Value
Next zeile2
Range("IV1:IV65536").ClearContents ' Hilfsspalte Inhalte löschen
End Sub
Gruß
Chris
Range("G:G").insert
with activesheet.usedrange.columns("G")
.formulalocal = "=H1&""-""&Aufrunden(Zeile()/3000;0)"
.formula = .value
end with
Range("H:H").delete
@Chris
mein Code braucht beim mir für 60.000 Zeilen c.a. 1 sek, deiner 12 - 13 sekunden.
Gruß, Daniel
Range("G:G").insert
with activesheet.usedrange.columns("G")
.formulalocal = "=H1&""-""&Aufrunden(Zeile()/3000;0)"
.formula = .value
end with
Range("H:H").delete
abweichen zu deinem Wunsch wird schon ab der ersten Zeile ein "-1" angefügt.
wenn das stört und die ersten 2999 Zeilen ohne Ergänzung bleiben sollen, müsste der Code so aussehen:
Range("G:G").Insert
With ActiveSheet.UsedRange.Columns("G")
.FormulaLocal = "=wenn(zeile()
Gruß, Daniel