Excel VBA - Duplikate ausblenden statt löschen

Liebes Forum,

ich habe eine Tabelle ohne Kopfzeile, mit einer statischen Anzahl an Spalten (A bis H) und variabler Anzahl an Zeilen (Erste Zeile: 13 bis X). Nun möchte ich die entsprechende variable Range nach Duplikaten durchsuchen und die ganze Zeile des Duplikats nicht weiter anzeigen lassen. Als Duplikate sollen nur solche Zeileneinträge angesehen werden, deren Werte in den Spalten 1, 6, 7 und 8 mit einem zuvor gelisteten Eintrag übereinstimmen. Mit dem folgenden Code werden bereits alle richtigen Zeileineinträge erkannt und gelöscht:

ActiveSheet.Range("A13:H" & X).RemoveDuplicates Columns:=Array(1, 6, 7, 8), Header:=xlNo

Meine Frage hierzu lautet: Gibt es eine Möglichkeit diese Zeileneinträge nicht zu löschen, sondern nur auszublenden - und das ohne Schleife?

Viele Grüße

Lukas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

dim Ausblenden as range With Range("I13:I" & x) .FormulaR1C1 = "=IF(CountIFs(R13C1:RC1,RC1,R13C6:RC6,RC6,R13C7:RC7,RC7,R13C8:RC8,RC8)=1,"""",1)" .Formula = .Value if Worksheetfunction.sum(.cells) > 0 then set Ausblenden = .SpecialCells(xlcelltypeconstants, 1) .ClearContents .EntireRow.Hidden = true end if end with

Sub Unit() Dim z As Long For z = 14 To Range("A13:H" & Rows.Count).SpecialCells(xlCellTypeLastCell).Row If Application.CountIfs(Range("A13:A" & z - 1), Cells(z, "A"), _ Range("F13:F" & z - 1), Cells(z, "F"), _ Range("G13:G" & z - 1), Cells(z, "G"), _ Range("H13:H" & z - 1), Cells(z, "H")) Then Rows(z).RowHeight = 0 End If Next End Sub

Ich habe das Problem nun komplett anders gelöst, jedoch auch nur mit einer Schleife. Die Idee war, den Zellinhalt in Anhänigkeit jeder Zeile und jeder Spalte, die zur Dupikatsprüfung mit einbezogen werden sollen in einen Array aufzunehmen. Anschließend soll der Array nach dem zuletzt zugefügten Wert durchsucht werden und wenn dieser häufiger als ein mal auftaucht, soll seine Zeile ausgeblendet werden. Zusätzlich habe ich einen "." zu Beginn und am Ende jedes Eintrags eingefügt, sodass keine "falschen" Duplikate ausgeblendet werden.

Der funktionierende Code dazu sieht so aus:

Dim Abgleich, Vergleich() As Variant



For i = 13 To X

        Vergleich(i) = "." & ActiveSheet.Cells(i, 1) & "-" & _

                       ActiveSheet.Cells(i, 6) & "-" & _

                       ActiveSheet.Cells(i, 7) & "-" & _

                       ActiveSheet.Cells(i, 8) & "."

        Abgleich = Filter(Vergleich, Vergleich(i), , vbTextCompare)

        If UBound(Abgleich) - LBound(Abgleich) + 1 > 1 Then

            ActiveSheet.Rows(i).EntireRow.Hidden = True

        End If

Next

Beliebteste Forumthreads (12 Monate)

Excel VBA - Duplikate ausblenden statt löschen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel VBA - Duplikate ausblenden statt löschen

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread