VBA Excel - Doppelte Einträge herauslöschen (beide)

[scriper]

Hallo zusammen,

ich habe eine Spalte A in der Werte wie folgt stehen:

II02569

II35698

II75845

Hier sind einige Einträge doppelt vorhanden.

Nun möchte ich per VBA die doppelten Einträge herauslöschen - aber nicht nur die Dublette, sondern beide.

Wie bewerkstellige ich dies am besten?

LG,

Scriper

[MartinSt]

Sind die Daten der Spalte sortiert bzw. könnte man sie sortieren?

Wenn ja, kannst du einfach durchiterieren und löschen.

[smash]

Da könnte ich mir mehrere Algorithmen vorstellen:

• Array für die Inhalte erstellen
  
• Array für die Anzahl der jeweiligen Inhalte erzeugen
  
• Die Spalte komplett durchlaufen
  
• Wenn der Inhalt bereits im Array ist, nur die Anzahl um 1 erhöhen
  
• Wenn der Inhalt noch nicht im Array ist, einfügen und Anzahl auf 1 setzen
  
• Nach dem erstem Durchlauf nochmal die Spalte durchlaufen.
  
• Wenn die Anzahl zum jeweiligen Inhalt > 0 ist dann den Inhalt löschen
  

Wichtig ist, dass immer zwei Einträge in beiden Arrays zusammen gehören. Dafür gibt es in vielen Sprachen Hashmaps. Ob es die in VBA auch gibt weiß ich nicht. Ich bin kein VBA Experte. Könnte also ohnehin sein, dass Excel da schon etwas fertiges mitbringt.

Quick and Dirty aus dem Kopf mit falscher Syntax / halb Pseudocode:

Array anzahl

Arrray inhalt

[startzelle].select //z.B. [a1]

dim rowOffset as Integer

rowOffset = 0

DO UNTIL activecell.offsett(rowOffset, 0).value = ""

IF inhalt contains activecell.offset(rowOffset, 0).value THEN

index = inhalt.getIndexOf( activecell.offset(rowOffset, 0).value)

anzahl[index] = anzahl[index] + 1

ELSE

inhalt.add(activecell.offset(rowOffset, 0).value)

anzahl.add(1)

END IF

LOOP

rowOffset = 0

DO UNTIL activecell.offsett(rowOffset, 0).value = ""

IF 0 < anzahl[inhalt.getIndexOf(activecell.offset(rowOffset, 0).value)] THEN

activecell.offset(rowOffset, 0).LÖSCHEN

END IF

LOOP

[streffin]

Mhm, ich glaub der Vorposter meint ein 2 Dimensionales Array, und nicht wirklich 2 Arrays.

In Excel kannste folgendes machen, das wär... schneller ....

1. - Sortier dein Sheet nach der Spalte in der deine ID steht. (makro aufzeichner)

2. -

sub blablub()

dim col as integer 'in Excel 2007 brauchste da eventuell ne Long, 

'aber mehr als 32k Spalten sollte das Fiie dann eigentlich auch dann nich haben

col = "die Spalte in der deine ID steht, als Zahl, nicht als das dämliche A B C"


dim i as long 'integer in vba is kein wirklicher integer



for i = 1 to activeSheet.usedRange.Rows.Count

   if cells(i,col).value = cells(i+1, col).value AND cells(i,col).Value <> "" then

       while cells(i,col).value = cells(i+1, col).value

            rows(i+1,col).entireRow.delete

       Wend

       rows(i).entireRow.delete     

   Endif

next


end sub

Ungetestet, grob übern Daumen, das sollte eigentlich schon reichen.

Gruß

Sven

Bearbeitet 3. September 2010 von streffin

[streffin]

Mhm, ich glaub der Vorposter meint ein 2 Dimensionales Array, und nicht wirklich 2 Arrays.

In Excel kannste folgendes machen, das wär... schneller ....

1. - Sortier dein Sheet nach der Spalte in der deine ID steht. (makro aufzeichner)

2. -

sub blablub()

dim col as integer 

col = "die Spalte in der deine ID steht, als Zahl, nicht als das dämliche A B C"


dim j as integer = 0


for i = 1 to activeSheet.usedRange.Rows.Count

j = 1

if cells(i,col).value = cells(i+1, col).value then

    while cells(i,col).value = cells(i+j,col).value

       j=j+1

    Wend

    Rows(Cstr(i)+":"+Cstr(j)).delete 'bei der Zeile bin ich mir nich 100% sicher 

end if


next


end sub

Ungetestet, grob übern Daumen, das sollte eigentlich schon reichen.

Gruß

Sven

[streffin]

to late for edit :

was eventuell sinn macht is dass de bei den Cells(x,y).Value Vergleichen noch die Leerzeichen rechts und links trimmst. Wenn mich die Erinnerung nicht trügt wäre das RTRIM(<String>) und LTRIM(<String>).

Ps. 15min is a weng over the Top imo, da könnt au duchaus ne Stunde angemessen sein zum Editieren