Anzeige
Archiv - Navigation
1768to1772
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bestimmte Anzahl an einträgen kopieren

Bestimmte Anzahl an einträgen kopieren
06.07.2020 14:23:13
Andreas
Hallo Liebe Excel Spezialisten,
ich bräuchte mal wieder eure Hilfe in Sachen Excel Rohdaten auslesen.
Es geht dabei um eine Datei die per Skript ausgelesen wird. Original ist es eine CSV Datei. Das Original enthält ca. 500.000 Zeilen.
In Spalte C stehen Nummern. Ich möchte nun die letzten 80 Zeilen jeder Nummer kopieren und in das dafür vorgesehenen Tabellenblatt mit der gleichen Nummer eintragen.
Diese Liste wird in Zukunft länger werden und neue nummern werden hinzukommen. Daher muss jedes Mal wenn ich diese Rohdaten in diese Liste eintrage und die letzten 80 Zeilen in das dafür vorgesehene Tabellenblatt kopiert werden, die bestehenden Daten darin gelöscht werden.
Einfache Zeilen kopieren und in ein Tabellenblatt einfügen bekomme ich hin aber mit dem zählen und den schleifen komme ich am mein Limit.
Sollte es eine Nummer geben für die noch kein Tabellenblatt angelegt ist, dann sollte ein Hinweis kommen diese bitte anzulegen oder das Skript legt das Tabellenblatt gleich mit an.
Hat Jemand von euch eine Idee wie man das hin bekommt?
Liebe Grüße und vorab shon mal vielen Dank für eure Unterstützung.
Andi
Hier mal eine Beispieldatei:
https://www.herber.de/bbs/user/138807.xlsx

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

Betreff
Datum
Anwender
Anzeige
AW: Bestimmte Anzahl an einträgen kopieren
06.07.2020 16:50:22
UweD
Hallo
so?

Option Explicit
Sub Last80()
Dim TB As Worksheet, TBx As Worksheet, TBT As Worksheet
Dim Sp As Integer, LR As Long, LRT As Long, Z1 As Integer
Dim i As Long, Blatt As String, JaNein As Variant
Dim LC As Integer, Topp As Integer, Anzahl As Integer
Set TB = Sheets("configuration")
Sp = 3 'Daten aus Spalte C
Z1 = 3 ' Erste Zeile mit Daten
Topp = 80
Application.ScreenUpdating = False
'Hilfsblatt anlegen
If IsError(Evaluate("Temp!A1")) Then
Set TBT = Sheets.Add(After:=Sheets(Sheets.Count))
TBT.Name = "Temp"
Else
Set TBT = Sheets("Temp")
End If
If TB.AutoFilterMode Then TB.AutoFilterMode = False ' Autofilter ausschalten
LR = TB.Cells(TB.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
LC = TB.Cells(Z1 - 1, TB.Columns.Count).End(xlToLeft).Column + 1 'letzte Spalte plus 1
'Unterschiedliche Nr. darstellen
TB.Columns(Sp).Copy TBT.Columns(1)
TBT.Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo
LRT = TBT.Cells(TBT.Rows.Count, 1).End(xlUp).Row
For i = Z1 To LRT
Blatt = TBT.Cells(i, 1)
'Prüfen auf Blatt schon vorhanden
If IsError(Evaluate(Blatt & "!A1")) Then
JaNein = MsgBox("Blatt: " & Blatt & " nicht vorhanden!" _
& vbLf & vbLf & "Anlegen?", vbYesNo)
If JaNein = vbYes Then
'Blatt anlegen
Set TBx = Sheets.Add(After:=Sheets(Sheets.Count))
TBx.Name = Blatt
Else
MsgBox "Abbruch"
GoTo Ende
End If
Else
Set TBx = Sheets(Blatt)
End If
'reset
TBx.UsedRange.EntireRow.Delete
TB.Cells(Z1 - 1, Sp).Resize(LR).AutoFilter Field:=1, Criteria1:=Blatt
'Überschrift kopieren
TB.Rows(Z1 - 1).Copy TBx.Rows(Z1 - 1)
'gefilterte Zeilen kopieren
TB.Cells(Z1 - 1, 1).CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible). _
EntireRow.Copy _
TBx.Rows(Z1)
LR = TBx.Cells(TBx.Rows.Count, 1).End(xlUp).Row
Anzahl = LR - Z1 + 1
If Anzahl  0 Then
'mehr als 80 weglöschen
TBx.Cells(Z1 - 1, 1).CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible). _
EntireRow.Delete
End If
'Filter ausschalten
TBx.AutoFilterMode = False
'Hilfsspalte wieder löschen
TBx.Columns(LC).Delete
Next
'Hauptfilter ausschalten
TB.AutoFilterMode = False
MsgBox "Fertig", vbExclamation
Ende:
'Hilfsblatt löschen
With Application
.DisplayAlerts = False
TBT.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

LG UweD
Anzeige
AW: Bestimmte Anzahl an einträgen kopieren
07.07.2020 10:44:59
Andreas
Hallo UweD,
Was soll ich sagen. Mir fehlen quasi die Worte. Einfach GEnial. Es ist genau das was ich brauche.
Grandios. Wäre ich so nie darauf gekommen.
Danke Dir auch für das saubere skript das sich gut nachvollziehen lässt.
Klasse, bin immer wieder begeister über das Fachwissen hier im Forum.
Grüße
Andi
Besten Dank für die Rückmeldung. owT
07.07.2020 11:39:36
UweD
AW: Bestimmte Anzahl an einträgen kopieren
06.07.2020 17:11:30
Sven
Hallo,
vorausgesetzt ich habe das richtig verstanden. Wie wäre es mit PowerQuery die csv direkt in das Excel Datenmodell zu laden. Anschließend die Abfrage duplizieren da du ja zwei Tabellen erhalten möchtest.
In diesen Abfragen wären 2 Schritte notwendig. Erstens Filtern nach 5401 bzw 5402. Und zweitens Letzte Zeilen beibehalten in Höhe von 80.
Noch als Tabelle in dein Excel-Dokument laden fertig. Und wenn es eine neue csv gibt Aktualisieren drücken.
In der Beispieldatei wird deine Tabelle anstatt der csv in PowerQuery geladen.
https://www.herber.de/bbs/user/138814.xlsx
Gruss
Sven A.
Anzeige
AW: Bestimmte Anzahl an einträgen kopieren
06.07.2020 17:15:06
Sven
Hi,
sorry eben erst gesehen das du excel vor 2013 eingetragen hast. also bei dir nicht umsetzbar.
vg
s.a.
AW: Bestimmte Anzahl an einträgen kopieren
07.07.2020 10:41:59
Andreas
Hallo Sven, ja Danke dir. PowerQuery wäre jetzt quch ein ganz neues Thema für mich.
Danke dir trotzdem für deine Unterstützung.
Grüße
Andi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige