Duplikate nur einmal bearbeiten

Question

Hallo,

mit dem folgenden Code suche ich in einer Spalte "P" nach einem mehrfach vorkommenden Kennzeichen:
..
For Each rng In Range("P:P")
If Application.CountIf(Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row), rng) > 1 Then
MsgBox rng & " " & Application.CountIf(Range("P:P"), rng)
End If
...
Wenn ich einen Treffer lande möchte ich mit diesen Datensätzen (die in Spalte "P" den gleichen Inhalt haben) weitere Berechnungen vornehmen.
Jetzt möchte ich aber ausschließen, das bei einem der nächsten Schritte, diese Datensätze noch einmal selektiert werden...
Ich hoffe, ich konnte mich einigermaßen verständlich ausdrücken...
Hat jemand einen Tipp?
Gruß Andreas

Answer 1

Hallo Andreas,

Ich hoffe, ich konnte mich einigermaßen verständlich ausdrücken...

,,,,einigermaßen schon, aber nicht verständlich :-))

Angenommen Du findest ein oder mehrere Duplikate in Spalte P, was soll dann mit den korrespondierenden Datensätzen passieren?

- welche Berechnungen?
- was bedeutet "nächste Schritte"?

Gruß
Rainer

Answer 2

Hallo Rainer,

bei .."each rng... wird die Datei ja datensatzweise durchsucht. Angenommen es werden für einen Datensatz in Zeile 3 Spalte P-Duplikate in den Zeilen 5 und 7 gefunden, dann will ich aus diesen 3 Datensätzen bestimmte Informationen auslesen.
Wenn ich im weiteren nach anderen Duplikaten suche, sollen die bereits "bearbeiteten" Datensätze in Zeile 5 und 7 natürlich ausgenommen werden.
A.

Answer 3

Hallo Andreas,

versuche es mal mit folgender If-Abfrage:

If Application.CountIf(Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row), Rng) > 1 And Application.CountIf(Range("P3:P" & Rng.Row), Rng) = 1 Then

Gruß

M.O.

Answer 4

Hi Andreas,

wenn ich dein Anliegen richtig verstanden habe, dann versuche es nach diesem Prinzip:

Sub NurErsterEintrag()
Dim rngZelle As Range
Dim lngZeile As Long
For Each rngZelle In Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row)
If Application.CountIf(Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row), rngZelle) > 1 Then
lngZeile = Application.Match(rngZelle, Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row), 0) + 2
If rngZelle.Row > lngZeile Then
MsgBox "mache nix"
Else
MsgBox "Hier ist Handlung erforderlich"
End If
End If
Next rngZelle
End Sub

Bis später,
Karin

Answer 5

Hallo,
danke M.O. und Karin für eure Tipps!! Die Formel von M.O. funktioniert einwndfrei.

Dein Vorschlag, Karin, passt auch prima und ich finde ihn auch sehr gut, weil er mir bei der weiteren Bearbeitung meines Problems hilft. Ich suche noch nach einer Möglichkeit, bei der die betreffenden Adressen/Zeilennummern für das jeweilige Auftreten der Duplikate "zwischengespeichert" werden. Ich muss im Folgenden aus diesen Datensätzen Produktnummern auslesen, mit denen ich weitere Berechnungen vornehme.
Also angenommen der Datensatz in Reihe 5 hat in den Zeilen 8 und 11 in der Spalte "P" noch zwei Duplikate, dann bauche ich den Zellinhalt von "P5" und die Zeilen 8 und 11 für die "Zwischenrechnung". Dann geht's zurück in die Schleife

For Each rngZelle In Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row)....

wobei dann die Datensätze in den Reihen 5,8 und 11 natürlich übergangen werden müssen.
Gruß Andreas

Answer 6

Hallo Andreas,

mal ein Beispiel, wie man so etwas lösen könnte (hier mit Filter):

Sub Beispiel()

Dim Rng As Range
Dim FilterRng As Range

For Each Rng In Range("P3:P" & ActiveSheet.Cells(Rows.Count, 16).End(xlUp).Row)


If Application.CountIf(Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row), Rng) > 1 And Application.CountIf(Range("P3:P" & Rng.Row), Rng) = 1 Then
'Filtern
ActiveSheet.Range("P3:P" & ActiveSheet.Cells(Rows.Count, 16).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Rng.Value

'gefilterte Zellen durchlaufen
For Each FilterRng In Range("P3:P" & Cells(Rows.Count, 16).End(xlUp).Row).Cells.SpecialCells(xlCellTypeVisible)
'hier nun die Weiterverarbeitung der gefilterten Datensätze
MsgBox Rng.Value & ": " & FilterRng.Row
Next FilterRng
'Filter aufheben
With ActiveWorkbook.ActiveSheet
If .FilterMode Then .ShowAllData
End With

End If

Next Rng

End Sub

Gruß

M.O.

Answer 7

Hi Andreas,


leider schreibst du nicht, was du wann genau machen willst mit den gefundenen Dopplern - deshalb hier eine Lösung, dass die Zelladressen in ein Array geschreiben werden, welches du dann später auswerten kannst:

Sub NurErsterEintrag()
Dim rngZelle As Range
Dim rngMehrfach As Range
Dim arrMehrfach()
Dim lngMehrfach As Long
Dim lngZeile As Long
Dim lngLetzte As Long
lngLetzte = Cells(Rows.Count, 16).End(xlUp).Row
For Each rngZelle In Range("P3:P" & lngLetzte)
If Application.CountIf(Range("P3:P" & lngLetzte), rngZelle) > 1 Then
lngZeile = Application.Match(rngZelle, Range("P3:P" & lngLetzte), 0) + 2
If rngZelle.Row > lngZeile Then
MsgBox "mache nix"
Else
Set rngMehrfach = Range("P3:P" & lngLetzte).Find(rngZelle.Value, lookat:=xlWhole)
Do
ReDim Preserve arrMehrfach(0 To 1, 0 To lngMehrfach)
arrMehrfach(0, lngMehrfach) = rngZelle.Value
arrMehrfach(1, lngMehrfach) = rngMehrfach.Address
lngMehrfach = lngMehrfach + 1
Set rngMehrfach = Range("P3:P" & lngLetzte).FindNext(rngMehrfach)
Loop While Not rngMehrfach Is Nothing And rngMehrfach.Row <> lngZeile
End If
Set rngMehrfach = Nothing
End If
Next rngZelle
End Sub

Bis später,
Karin

Answer 8

Hallo Karin,

obwohl meine Beschreibung zugegebenermaßen ungenau ist (es ist schwer den ganzen Sachverhalt in wenigen Worten verbal zu erklären...) bist du genau auf dem richtigen Weg. Ich hatte auch schon an diese Variante "Zwischenspeichern" gedacht, aber leider keine Ahnung und Erfahrung mit dem Array.
Ich habe deinen Code an einem einfachen Beispiel für mich getestet, um ihn überhaupt zu verstehen, was mir aber noch nicht ganz gelungen ist:
Sub NurErsterEintrag()
Dim rngZelle As Range
Dim rngMehrfach As Range
Dim arrMehrfach()
Dim lngMehrfach As Long
Dim lngZeile As Long
Dim lngLetzte As Long
lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngZelle In Range("A1:A" & lngLetzte)
If Application.CountIf(Range("A1:A" & lngLetzte), rngZelle) > 1 Then
lngZeile = Application.Match(rngZelle, Range("A1:A" & lngLetzte), 0)
If rngZelle.Row > lngZeile Then
MsgBox "mache nix"
Else
Set rngMehrfach = Range("A1:A" & lngLetzte).Find(rngZelle.Value, lookat:=xlWhole)
Do
ReDim Preserve arrMehrfach(0 To 1, 0 To lngMehrfach)
arrMehrfach(0, lngMehrfach) = rngZelle.Value
arrMehrfach(1, lngMehrfach) = rngMehrfach.Address
lngMehrfach = lngMehrfach + 1
Set rngMehrfach = Range("A1:A" & lngLetzte).FindNext(rngMehrfach)
Loop While Not rngMehrfach Is Nothing And rngMehrfach.Row <> lngZeile
End If
Set rngMehrfach = Nothing
End If
Next rngZelle
End Sub

Bsp. wie folgt, "A1:A13"", a und b kommen als Duplikate vor:
1
2
3
4
a
6
7
b
9
10
a
b
11
12
b
13
Wo und wie kann ich mit deinem Code das Array auswerten. Kannst du noch eine Zeile mit einer msgbox oder Auflistung neben der Tabelle einfügen?
Danke im Voraus und Gruß Andreas

Answer 9

Hi Andreas,

im Array stehen in der Spalte 0 jeweils die betreffenden Mehrfachwerte (in deinem Beispiel 2 x a und 3 x b) und in Spalte 1 jeweils die dazugehörigen Zelladressen - das Array ist also so ausgefüllt

a A5
a A11
b A8
b A12
b A15

Das Array muss 2 Spalten haben, denn anderfalls kann man ja nicht feststellen, welche Zelladresse zu welchem Mehrfachwert gehört.

Wenn du das Ergebnis im Tabellenblatt ausgeben willst, dann so:

Range("D1").Resize(UBound(arrMehrfach(), 2) + 1, 2) = Application.Transpose(arrMehrfach())

Willst du dagegen jedes einzelne Wertepaar auswerten, dann in einer Schleife:

For lngZeile = 0 To UBound(arrMehrfach(), 2)
MsgBox arrMehrfach(0, lngZeile) & vbTab & arrMehrfach(1, lngZeile)
Next lngZeile

Ubound ist die Obergrenze des Arrays, also die Anzahl an enthaltenen Zeilen, wobei die Zählung standardmäßig bei 0 beginnt.


bis später,
Karin

Answer 10

Hallo Karin,

ich komme leider erst heute dazu, mich für deinen Beitrag zu bedanken - wie immer kompetent, verständlich und hilf- und lehrreich!!
Gruß Andreas