Nach doppelte Werte suchen und einzeln ausdrucken

Forumthread: Nach doppelte Werte suchen und einzeln ausdrucken

05.12.2019 15:19:10

Hi Leute,
Ich komme heute mit einem anderen Problem zu euch.
Ich habe eine Tabelle in der in der Spalte H Werte stehen, die Doppelt sein können.
https://www.herber.de/bbs/user/133623.xlsx
Ich möchte nun für jedes Ventil Ein Etikett ausdrucken mit der kompletten Spalte (z.B.:A3:I3 ; A4+5:I4+5 ; A6:I6)
Der Drucker heißt DE_Label
Die Wiederholungzeilen sind A1:I2
Das mit den Wiederholungszeilen bekomme ich hin.
Wie kann ich es aber machen, das er mir nacheinander die einzelnen Etiketten ausdruckt?
Zum besseren Verständnis habe ich in Spalte J die Nummer der Etiketten eingetragen.
In diesem Falle wären es 3 Etiketten.
1x Zeile 3
1x Zeile 4+5
1x Zeile 6
Wenn es notwendig wäre könnte ich die spalte J auch Automatisch eintragen lassen.
Mir wäre es aber lieber, wenn ich sie nicht brauche.
Ich hoffe ich konnte Verständlich machen was ich brauche.
Ich bedanke mich jetzt schon für eure Lösungsvorschläge.
Schön wäre es auch wenn man den Code etwas Erläutern könnte, damit ich auch dabei Lerne.
Danke

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Nach doppelte Werte suchen und einzeln ausdrucken

06.12.2019 15:39:22

fcs

AW: Nach doppelte Werte suchen und einzeln ausdrucken

06.12.2019 15:39:22

fcs

Hallo B.Eiko,
soweit ich das verstehen konnte werden die Armaturen zu einem Ettikett zusammengezogen, wenn in Spalte H die ersten 5 Zeichen identisch sind. Dann wird Spalte J nicht als Hilfsspalte benötigt.
Nachfolgend ein entsprechendes Makro.
1. es wird geprüft, ob der Label-Drucker der aktive Drucker ist
Wenn man den genauen Druckernamen kennt, dann kann man es auch anders lösen.
2. Alle Werte in Spalte H werden geprüft, ob die ersten 5 Zeichen identisch sind in in einem sog. Collection-Objekt gesammelt.
3. Der Autofilter wird vorbereitet und das Seiten-Layout angepasst.
4. In einer Schleife wird der Filter in Spalte H auf die gesammelten Werte gesetzt und jeweils gedruckt.
5. der Autofilter wird wieder deaktiviert.
LG
Franz

Sub Ettiketten_Drucken()
Dim strPrinter As String
Dim wks As Worksheet
Dim Zeile As Long, Zeile_L As Long
Dim objCol As New Collection, iItem
On Error GoTo Fehler
strPrinter = Application.ActivePrinter
'Aktiven Drucker prüfen, ob Label-Drucker
If InStr(LCase(strPrinter), LCase("DE_Label")) = 0 Then
MsgBox "Bitte wählen sie im Drucker Menü erst den Label-Drucker aus" & vbLf _
& "Dann Makro neu starten", _
vbOKOnly, "Ventil-Ettiketten drucken"
Exit Sub
End If
Set wks = ActiveSheet
With wks
'letzte Zeile mit Inhalt in Spalte H
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
'Alle Werte ohne doppelte in Spalte H in Collection sammeln, dabei nur die _
ersten 5 Ziffern berücksichtigen
For Zeile = 3 To Zeile_L
objCol.Add Item:=Left(.Cells(Zeile, 8).Text, 5), Key:=Left(.Cells(Zeile, 8).Text, 5) _
Next
'Seite einrichten
With .PageSetup
'Druckbereich
.PrintArea = "A3:I" & Zeile_L
'Wiederholungszeilen
.PrintTitleRows = "$1:$2"
.Orientation = xlLandscape 'Querformat   '?
End With
'Falls Autofilter aktiv, dann deaktivieren
If .AutoFilterMode = True Then .AutoFilterMode = False
'Autofilter setzen für alle Daten in Spalte A:I ab Zeile 2
.Range(.Cells(2, 1), .Cells(Zeile_L, 9)).AutoFilter
'Filter für die Werte in Spalte H setzen (5 erste Zeichen identisch) und jeweils  _
drucken
For iItem = 1 To objCol.Count
.AutoFilter.Range.AutoFilter Field:=8, Criteria1:=objCol(iItem) & "*"
.PrintOut Preview:=False
.ShowAllData
Next
.AutoFilterMode = False
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 457 'doppelter Wert für Collection überspringen
Resume Next
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Nach doppelte Werte suchen und einzeln ausdrucken

Forumthread: Nach doppelte Werte suchen und einzeln ausdrucken

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread