Widerholungen in Spalte entfernen?

Hallo,
Ich versuche mal das Problem genau zu beschreiben. Ein Hochladen der gesamten Mappe scheitert leider an der Größe.
Meine Tabelle Bearbeiten wird, wenn fertig ausgefüllt- gedruckt. Das Funktioniert alles sehr gut. Ein Druckmakro erstellt aus 30 Zeilen eine A4 Seite.
Nun möchte ich, der Übersicht halber- bevor das Blatt zum Drucken geht- pro Seite Wiederholungen in der Spalte "B" vermeiden. Das ist die Raum-oder der Ort.
Es reicht, wenn pro Blatt die Bezeichnung in Spalte "B" nur einmal an erster Stelle vorkommt. Erst wenn sich die Raumbezeichnung ändert- soll die neue einmal vorkommen, wieder an erster Stelle.
Es werden je Seite 30 Zeilen gedruckt. Würde bedeuten:
in B1-B30 darf ein Zellinhalt nur einmal vorkommen, und das an oberster Stelle.
nächste Seite ist Zeile 31-60, dann 61-90; 91-120 usw.- bis Ende.
Habe mal eine Mappe mit vorher und nachher zusammengestellt, jedoch musste alles andere weichen, da die KB Größe zum Hochladen leider sehr sehr gering ist.
https://www.herber.de/bbs/user/111758.xlsx
Wie könnte man dies mit VBA lösen?
Lg Andi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Daniel,
habe mal das Makro aufgezeichnet und etwas modifiziert. Nun werde ich nur die Formel-Spalte in der Hilfstabelle etwas nach unten verlängern, da ich auch mal bis zu 3500 Zeilen dort stehen haben könnte. Super Formel- macht genau was sie soll.
Kann das Makro so bleiben oder ist dies noch modifizierbar?


Sub Makro6()
' Entferne Wiederholungen
If MsgBox("sollen Wiederholungen in Spalte B entfernt werden?", vbQuestion + vbYesNo) =  _
vbYes Then
Application.ScreenUpdating = False
Sheets("Bearbeiten").Select
Columns("A:B").Select
Selection.Copy
Sheets("Hilfstabelle").Select
Columns("AM:AM").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AO:AO").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Bearbeiten").Select
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
MsgBox "Fertig"
End If
End Sub

Danke erst mal.
Grüße Andi

Sheets("Bearbeiten").Columns("A:B").Copy Sheets("Hilfstabelle").Columns("AM:AM").PasteSpecial Paste:=xlPasteValues Sheets("Hilfstabelle").Columns("AO:AO").Copy Sheets("Bearbeiten").Columns("B:B").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False

Beliebteste Forumthreads (12 Monate)

Widerholungen in Spalte entfernen?

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread