Duplikate in Msgbox ausgeben

Forumthread: Duplikate in Msgbox ausgeben

08.07.2020 14:46:16

Ahmed

Hallo zusammen,
ich verzweifele gerade an einer einfachen Sache. Ich hoffe, ihr könnt mir weiterhelfen:
Ich versuche aus einer Spalte die Duplikate wertmäßig zu erkennen und zur Weiterverwendung einer Variablen zuordnen.
Hier ein Beispiel:
In der Spalte A befinden sich folgende Zahlen:
5
6
1
3
4
5
5
5
6
3
Das Makro soll nun erkennen, dass es drei Duplikate gibt und zwar die Zahlen "5, 6" und "3" . Anschließend soll ihnen eine Variable zugeordnet werden. Beispiel Duplikat1="5"; Duplikat2="6" und Duplikat3="3".
Vielen Dank schon mal für eure Antworten

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Duplikate in Msgbox ausgeben

08.07.2020 15:05:24

UweD
Duplikate in ARRAY-Variable speichern

08.07.2020 15:06:29

NoNet
AW: Duplikate in Msgbox ausgeben

08.07.2020 15:09:54

Daniel

AW: Duplikate in Msgbox ausgeben

08.07.2020 15:05:24

UweD

Hallo


Sub Dups()
Dim Sp As Integer, Z1 As Integer, i As Long, LR As Long, Duplikat(), Anz As Integer
Z1 = 1 'Ab Zeile1
Sp = 1 'Spalte A
LR = Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
For i = 1 To LR
If WorksheetFunction.CountIf(Cells(Z1, Sp).Resize(i, 1), Cells(i, Sp)) = 2 Then
' Formel: =ZÄHLENWENN($A$1:A1;A1)=2
Anz = Anz + 1
ReDim Preserve Duplikat(1 To Anz)
Duplikat(Anz) = Cells(i, Sp)
Debug.Print "Duplikat" & Anz & "= "; Duplikat(Anz)
End If
Next
End Sub

LG UweD

Duplikate in ARRAY-Variable speichern

08.07.2020 15:06:29

NoNet

Hallo Ahmed,
Du könntest die Duplikate z.B. in eine ARRAY-Variable speichern - heir ein Beispiel :

Sub Duplikate_in_Array_Einlesen()
Dim lngS As Long, lngZ As Long
Dim arDuplikate 'Die ARRAY-Variable für die Duplikate
ReDim arDuplikate(0)
lngS = 1 'Erste Spalte überprüfen
For lngZ = 1 To ActiveSheet.Cells(Rows.Count, lngS).End(xlUp).Row
If Application.CountIf(Range(Cells(1, lngS), Cells(lngZ, lngS)), Cells(lngZ, lngS)) = 2  _
Then
arDuplikate(UBound(arDuplikate)) = Cells(lngZ, lngS)
ReDim Preserve arDuplikate(UBound(arDuplikate) + 1)
End If
Next
If UBound(arDuplikate) > LBound(arDuplikate) Then ReDim Preserve arDuplikate(UBound( _
arDuplikate) - 1)
MsgBox UBound(arDuplikate) - LBound(arDuplikate) + 1 & " Duplikate : " & vbLf & Join( _
arDuplikate, ","), _
vbInformation + vbOKOnly, "Duplikate :"
'Zugriff auf einzelne Werte :
For lngZ = LBound(arDuplikate) To UBound(arDuplikate)
MsgBox "Duplikat Nr." & lngZ & " : " & arDuplikate(lngZ)
Next
End Sub

Salut, NoNet

AW: Duplikate in Msgbox ausgeben

08.07.2020 15:09:54

Daniel

Hi
zur Duplikatermittlung eignet sich in VBA das Dictionary-Objekt:

Sub Duplikate()
Dim Zelle As Range
Dim dic As Object
Dim X
ReDim Duplikate(0)
Set dic = CreateObject("Scripting.Dictionary")
For Each Zelle In Columns(1).SpecialCells(xlCellTypeConstants, 1)
dic(Zelle.Value) = dic(Zelle.Value) + 1
Next
For Each X In dic.Keys
If dic(X) > 1 Then
ReDim Preserve Duplikate(UBound(Duplikate) + 1)
Duplikate(UBound(Duplikate)) = X
End If
Next
If UBound(Duplikate) = 0 Then
MsgBox "keine Duplikate vorhanden"
Else
MsgBox "Duplikate: " & vbLf & Join(Duplikate, " ")
End If
End Sub

das Ergebnis wird in einem Eindimensionalen Array abgelegt.
der erste Index(0) ist immer leer, das erste Duplikat wird dann ab dem Index 1 eingetragen.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Forumthread: Duplikate in Msgbox ausgeben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread