Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Restrukturierung bei gleichen Zelleninhalt

VBA: Restrukturierung bei gleichen Zelleninhalt
25.07.2018 14:56:25
Manuel
Liebe, Excel-Freunde.
Ich stehe leider mit meinem VBA know-how bei folgendem Sachverhalt auf der Leitung.
Anbei angefügt ist ein .xlsm File welches einen Materialstammdaten Datensatz erhält.
https://www.herber.de/bbs/user/122881.xlsx
Ziel ist es bei doppelten Werten in Spalte D (Material ID) - die ganze Zeile in einen extra Tab zu schieben (cut+paste). Wenn somit eine Material ID Datensatz 2-fach exisiert - wird der 2te Datensatz in einen extra tab verschoben (cut+paste). Wenn eine Material ID 3 Fach besteht werden 2 neue tabs erstellt in denen getrennt die 2 überflüssigen zeilen separat eingefügt werden.
Beispiel:
Material ID 000000000039002410 existiert 3x - durch click auf einen button wird der 2te Datensatz dieses Materials in einen neuen Tab (1) verschoben, und der 3te Datensatz wieder in einen weiteren Tab (2) verschoben.
Am Ende habe ich ein File welches im basis-tab nurnoch single daten enthält.
Tab 2 Enhält 2te doppelte datensätze
Tab 3 Enthält 3te datensätz
Ich bedanke mich schon im Voraus für eure Hilfe.
Gruß

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Autofilter
25.07.2018 15:07:13
Fennek
Hallo nach Wien,
in der 1. freien Spalte ein "=zählenwenn()" einfügen. Dann kann nach "2" und "3" mit dem Autofilter ausgewählt und kopiert werden.
mfg
AW: VBA Autofilter: so?
25.07.2018 15:46:04
Fennek

Sub T_1()
ls = Cells(1, Columns.Count).End(xlToLeft).Column + 1
lr = Cells(Rows.Count, 1).End(xlUp).Row
Cells(1, ls) = "Anzahl"
Columns(ls).NumberFormat = "General"
Range(Cells(3, ls), Cells(lr, ls)).Formula = "=countif(d:d, d3)"
With Cells(1).CurrentRegion
.AutoFilter ls, "2"
.Copy Sheets("(2)").Range("A1")
.AutoFilter
.AutoFilter ls, "3"
.Copy Sheets("(3)").Range("A1")
.AutoFilter
End With
End Sub

Anzeige
AW: VBA Autofilter: so?
25.07.2018 16:08:40
Manuel
Das Makro sieht schon gut aus jedoch habe ich glaube ein bisschen schlecht erklärt:
Das makro soll nicht datensätze mit 3 einträgen in (3) und datensätze mit 2 einträgen in (2) kopieren.
Das ziel ist es die datensätze zu trennen und das "Sheet1" von multiplen (gleichen) datensätzen zu bereinigen das heißt:
Wenn ich einen Datensatz habe der 3x enthalten ist (zB: 000000000039002410) soll dieser (Zeile 5) dort stehen bleiben, Zeile 6 in Tab (2) wandern und Zeile 7 in Tab (3) wandern.
Im endeffekt habe ich dann in Tab (2) alle single Datensätze die als 2tes vorgekommen sind und in (3) alle Datensätze die als 3tes vorgekommen sind (in unserem fall steht in (3) nur ein datensatz.. usw...
als erklärung wie das finale file aussehen soll habe ich es untenstehen beigefügt.
https://www.herber.de/bbs/user/122885.xlsx
Danke für eure (deine) hilfe und Grüße aus Wien!
Anzeige
AW: Idee
25.07.2018 16:23:47
Fennek
Hallo,
als Idee, d.h. ungeprüft

Range(Cells(3, ls), Cells(lr, ls)).Formula = "=countif(d$3:d3, d3)"
wenn alles passt, kommen noch die Lösch-Codes.
mfg
AW: Idee
25.07.2018 16:39:57
Manuel
Super genauso passt es nun!
Kannst du mir noch hilfe bei den Lösch codes geben? Gruß
Hier der Aktuelle Code:
Sub T_1()
' T_1 Macro
ls = Cells(1, Columns.Count).End(xlToLeft).Column + 1
lr = Cells(Rows.Count, 1).End(xlUp).Row
Cells(1, ls) = "Anzahl"
Columns(ls).NumberFormat = "General"
Range(Cells(3, ls), Cells(lr, ls)).Formula = "=countif(d$3:d3, d3)"
With Cells(1).CurrentRegion
.AutoFilter ls, "2"
.Copy Sheets("(2)").Range("A1")
.AutoFilter
.AutoFilter ls, "3"
.Copy Sheets("(3)").Range("A1")
.AutoFilter
End With
End Sub

Anzeige
AW: löschen: ungeprüft
25.07.2018 16:44:36
Fennek

.autofilter ls, ">1"
activesheet.usedrange.columns(1).specialcells(12).offset(1).entirerow.delete
.autofilter

AW: geprüft: komplett
25.07.2018 20:53:30
Fennek

Sub F_en()
ls = Cells(1, Columns.Count).End(xlToLeft).Column + 1
lr = Cells(Rows.Count, 1).End(xlUp).Row
Cells(1, ls) = "Anzahl"
Columns(ls).NumberFormat = "General"
Range(Cells(3, ls), Cells(lr, ls)).Formula = "=countif(d$3:d3, d3)"
With Cells(1).CurrentRegion
.AutoFilter ls, "2"
.Copy Sheets("(2)").Range("A1")
.AutoFilter
.AutoFilter ls, "3"
.Copy Sheets("(3)").Range("A1")
.AutoFilter
.AutoFilter ls, ">1"
Application.DisplayAlerts = False
.Offset(1).Delete
Application.DisplayAlerts = True
.AutoFilter
End With
End Sub

Anzeige
AW: geprüft: komplett
26.07.2018 09:46:14
Manuel
Fennek you saved my day!
Danke dir vielmals und grüße aus Wien!
M.

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige