Office: Array Duplikate Löschen

Muecke.1982 · 9. November 2017

Hallo miteinander,

ich habe das Problem das ich aus einer Großen Tabelle, zwei Zellen auslesen muss in der Nummern per ";" getrennt drin stehen muss, aus beiden Zellen muss ich dann die Duplikate Löschen und weiter verarbeiten.

Ich bin also hin gegangen und habe bei Zellen eingelesen.
Dann habe ich beide hintereinander geschrieben
Danach Splinte ich diese in ein Array
Dann erstelle ich ein Neues Datenblatt
In das Datenblatt trage ich dann die Werte aus dem Array ein
Aus Spalte A lasse ich dann die Duplikate Löschen
Dann Leere ich das Array und Lese alle werte die dann noch in Spalte A sind in das Array wider ein.
Dann Lösche ich das Datenblatt wider.

Das mag ein Logischer weg für mich sein, jedoch glaube ich das ich sehr umständlich arbeite.
Gibt es hierfür einen einfacheren und schnelleren weg? auch einer der nicht so Fehleranfällig ist wie meiner?

Würde mich freuen wenn Ihr da was habt.

Gruß Mücke

Eine Muster Datei habe ich auch im Anhang mit dem Code.
Das ist mein CODE:
Code:

Sub test()

Dim Vorderachse As String
Dim Hinterachse As String
Dim Fahrzeug As String
Dim Fahrzeug_Array() As String
Dim i As Integer

Vorderachse = Worksheets("Tabelle1").Range("B03") ' Zelle auslesen und in Variable schreiben
Hinterachse = Worksheets("Tabelle1").Range("C03") ' Zelle auslesen und in Variable schreiben
Fahrzeug = Vorderachse & ";" & Hinterachse ' Zellen hinteinander in String schreiben
Fahrzeug_Array = Split(Fahrzeug, ";") ' Alle werte in Array schreiben

Sheets.Add ' Neues Tabellenblatt
ActiveSheet.Name = "TMP_Duplikat_loeschen" ' Tabellen Blat umbenennen

For i = 0 To UBound(Fahrzeug_Array())
Worksheets("TMP_Duplikat_loeschen").Range("A" & i + 1) = Fahrzeug_Array(i) ' Array werte in Tabelle schreiben
Next i
Worksheets("TMP_Duplikat_loeschen").Range("$A$1:$A$" & i + 1).RemoveDuplicates Columns:=1, Header:=xlNo ' Duplikate Löschen
Erase Fahrzeug_Array() ' Array leeren

i = 0
Do While Worksheets("TMP_Duplikat_loeschen").Range("A" & i + 1) "" ' Prüfen ob Zelle Leer ist wenn ja dann abbrechen
ReDim Preserve Fahrzeug_Array(0 To i) ' Array vergrößern, ohne den Inhalt zu löschen
Fahrzeug_Array(i) = Worksheets("TMP_Duplikat_loeschen").Range("A" & i + 1) ' Wert aus Zelle in Array schreiben
i = i + 1 ' Zeilennummer hochzählen
Loop

Application.DisplayAlerts = False ' tabellenblat Löschen
Worksheets("TMP_Duplikat_loeschen").Delete ' tabellenblat Löschen
Application.DisplayAlerts = True ' tabellenblat Löschen

' ###################################### TMP ######################################
Dim Inhalt As String
' Dim i As Integer
For i = 0 To UBound(Fahrzeug_Array())
Inhalt = Inhalt & Fahrzeug_Array(i) & Chr(13)
Next i
MsgBox "Inhalt : " & Inhalt
' ###################################### TMP ######################################
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

rastrans · 11. November 2017

Du könntest auch dein Array selbst sortieren (QuickSort-Code findest du im Internet) und dann nach Duplikaten suchen und entfernen.

haklesoft · 11. November 2017

Hallo Mücke,

viele Wege führen nach Rom. *cool.gif*

Du könntest die Eigenheit einer Collection nutzen: der Index kann nicht doppelt vergeben werden. Den vergeblichen Versuch übergeht man mit On Error Resume Next und hat anschließend doublettenfreie Einträge in unveränderter Reihenfolge.

HS(V) · 11. November 2017

Hallo,

Z.B.
Code:

Sub hsv()
Dim sq, i As Long
sq = Split(Join(Application.Transpose(Application.Transpose(Range("b3").Resize(, 2))), ";"), ";")
With CreateObject("scripting.dictionary")
For i = 0 To UBound(sq)
.Item(sq(i)) = ""
Next i
MsgBox Join(.keys, vbLf)
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Muecke.1982 · 11. November 2017

Hallo miteinander,

@HS(V): ich glaube du hast die Idee von @haklesoft umgesetzt.

ich glaube ich habe auch das Prinzip verstanden, ich bin mir nur noch nicht so sicher wie ich das für die weitere Verarbeitung verwenden kann.

Code:

sq = Split(Join(Application.Transpose(Application.Transpose(Range("b3").Resize(, 2))), ";"), ";")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hiermit list du die Zellen B3 und C3 ein und verkettest diese mit einem ";" dann wird das alles auch gleich in ein Array umgewandelt.

damit ich das verstehe habe ich das mal so geschrien:
Code:

sq = Split(Worksheets("Tabelle1").Range("C3") & ";" & Worksheets("Tabelle1").Range("D3"), ";")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

! Habe die Spalten um eins verschätzen müssen :-( !

Dein Code funktioniert immer noch ohne Probleme.

So jetzt kommen wir zu dem Teil denn ich noch nicht für mich umschreiben kann :-(, da ich noch nicht alles verstanden habe :-(

Code:

With CreateObject("scripting.dictionary")
For i = 0 To UBound(sq)
.Item(sq(i)) = ""
Next i
MsgBox Join(.keys, vbLf)
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hier wird ein Objekt erstellt "scripting.dictionary"
dann wird das Array durchlaufen und warum auch immer wird immer ein "" nichts in das Item geschrieben.

mit der MsgBox wird dann der Inhalt der keys ausgegeben immer mit einem Zeilenumbruch getrennt.

Angenommen ich möchte auf das Array jetzt zugreifen wie kann ich das machen?
ich würde das gerne mit einer For Schleife in eine Tabelle schreiben können.

Mir ist bis jetzt nur nicht klar wie ich auf das Array zugreifen kann :-(

Könntest du mir hier etwas weiter helfen?

Gruß Mücke

haklesoft · 11. November 2017

@HS(V): ich glaube du hast die Idee von @haklesoft umgesetzt.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ne, ne. Harry zeigt Dir hier einen der anderen Wege. *mrcool

Muecke.1982 · 12. Januar 2021

von haklesoft

Ne, ne. Harry zeigt Dir hier einen der anderen Wege. *mrcool
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ach so, OK.

ich muss einen anderen weg nehmen als meinen :-( dadurch das ich immer ein neues Tabellen Blatt erstelle und wider Lösche bricht das Makro ab bei Tabellen bat nummre 10915 :-(.

Jetzt muss ich es noch hin bekommen bei Harry Weg auf das Array am schluß zuzugreifen. Ich verstehe nur nicht was das Array ist.

das .keys scheint das zu sein.
da ein Punkt vorne dran steht, gehört das glaube ich zu dem CreateObject

ich würde das gerne so schreiben können

Worksheets("Bla Bla Bla").Range("A1") = .keys(1)

nur was muss ich anstelle des .keys nehmen?
wo ist das Array denn drin versteckt? oder wie kann ich das in eine Variables Array das ich das wider aufrufen kann wie ich es kenne umwandeln?

Muecke.1982 · 11. November 2017

ich habe es hin bekommen :-)

habe das Objekt in eine Variable gepackt.

dann kann ich die Variable mit dem .Keys() wider aufrufen. und die Werte abfragen :-)

so klapt das, das ist einfach genial.

DANKE, Danke, Danke.

das ist mein Test CODE, mit dem ich gerade die sahen ausprobiert habe.

Code:

Sub hsv()
Dim sq, i As Long
Dim arr As Object
Set arr = CreateObject("scripting.dictionary")

' sq = Split(Join(Application.Transpose(Application.Transpose(Range("b3").Resize(, 2))), ";"), ";")
sq = Split(Worksheets("Tabelle1").Range("C3") & ";" & Worksheets("Tabelle1").Range("D3"), ";")

With arr
For i = 0 To UBound(sq)
.Item(sq(i)) = ""
Next i
MsgBox Join(.keys, vbLf)
End With

MsgBox "arr 0 bis " & UBound(arr.keys()) & Chr(13) & "arr key 1 = " & arr.keys()(1)

Dim Inhalt As String
For i = 0 To UBound(sq)
Inhalt = Inhalt & sq(i) & Chr(13)
Next i
MsgBox "Inhalt : " & Inhalt

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Mücke

HS(V) · 12. November 2017

Hallo Mücke,

Code:

c00 = Worksheets("Tabelle1").Range("B3") & ";" & Worksheets("Tabelle1").Range("C3")
MsgBox "Inhalt: " & vbLf & Join(Split(c00, ";"), vbLf)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Muecke.1982 · 12. Januar 2021

von HS(V)

Hallo Mücke,

Code:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

c00 = Worksheets("Tabelle1").Range("B3") & ";" & Worksheets("Tabelle1").Range("C3")
MsgBox "Inhalt: " & vbLf & Join(Split(c00, ";"), vbLf)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hallo Harry,

ich bin mir nicht sicher was du mir mit diesem Code sagen möchtest.
Ich bekomme alle Elemente untereinander aufgelistet, inklusive der Duplikate.

Ich stehe gerade auf dem Schlauch was du mir mitteilen möchtest :-(

Gruß Mücke

HS(V) · 14. November 2017

Hallo Mücke,

Den letzten Teil des Codes....

Code:

Dim Inhalt As String
For i = 0 To UBound(sq)
Inhalt = Inhalt & sq(i) & Chr(13)
Next i
MsgBox "Inhalt : " & Inhalt
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

... mache ich hier ohne Schleife.
Code:

c00 = Worksheets("Tabelle1").Range("B3") & ";" & Worksheets("Tabelle1").Range("C3")
MsgBox "Inhalt: " & vbLf & Join(Split(c00, ";"), vbLf)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Array Duplikate Löschen

Array Duplikate Löschen

Array Duplikate Löschen

Array Duplikate Löschen

Array Duplikate Löschen

Array Duplikate Löschen - Similar Threads - Array Duplikate Löschen

Mittelwert aus mehreren Spalten als dynamisches Array

Adressen in eine Zelle bei Übereinstimmung eindeutiger Werte einer anderen Spalte

Zahlendubletten im Array

Array aus Excel Tabelle einlesen Word VBA

Summenteilergebnis eines Arrays als Array darstellen

Formel bei Veränderung von dynamischem Array "mitziehen"?

Array-Funktion mit VBA in Zelle schreiben