---

Beispiel.xls.txt

Hallo Zusammen,

ich hätt' da mal gern ein Problem. 

Und zwar habe ich eine (für mich) recht große Exceldatei (ca. 2000 Zeilen, 40 Spalten). In dieser befinden sich in den ersten beiden Spalten jeweils Artikelnummer und Artikelbezeichnung. In den nachfolgenden Spalten befinden sich beschreibende Informationen. Da die aber über einen SVERWEIS in die Tabelle gekommen sind, sind da teilweise viele gleiche Beschreibungen bei. Und genau die möchte ich jetzt entfernen.

Ich habe schon nach Lösungen gegoogelt und hier gesucht, aber leider nichts gefunden. Ich habe immer nur Lösungen gefunden wie ich Duplikate Zeilenweise entfernen kann, aber halt nicht Spaltenweise. 

Jetzt hoffe ich ganz stark auf Euch - sonst bedeutet das für mich nämlich seehr viel Handarbeit ...

Ich arbeite mit Excel 2000. Als Beispiel habe ich eine Datei angehangen die mein Problem verdeutlichen soll. Das ist zwar nur auf die schnelle selbst gestrickt, zeigt aber hoffentlich halbwegs klar wo mein Problem liegt.

Für sachdienliche Hinweise würde ich den Finder natürlich mit Us überschütten.

Danke schon einmal im voraus!

MfG

Chris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Chris,

vielleicht hilft dies:
Doppelte Löschen
angenommen Deine Daten stehen in A1 bis A????
Bereich markieren = Spalte A anklicken (evtl. eine Leerzeile vorher einfügen)
Daten / Filter / Spezialfilter
keine Duplikate
jetzt kannst du noch einstellen, ob an gleicher Stelle oder woanders placiert; hier also B1 eingeben
Spalte A anschließend löschen
Bei mehreren Spalten, muss die Liste eine Überschrift haben, am besten fett formatiert, dann erkennt sie auch Excel als Überschrift.

Gruß Hajo

[Diese Nachricht wurde von Hajo_Zi am 13. Sep. 2007 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Hajo,

vielen Dank für Deinen Tipp. Leider hat das auch nicht funktioniert (oder ich bin zu blöd dafür). Auf jeden Fall filtert er mir nichts aus. Ich denke das Problem liegt darin das die Duplikate Spaltenweise vorhanden sind und nicht zeilenweise.
Ich experimentiere im Moment damit, die einzelnen Werte in verschiedene Zeilen zu transponieren / pivotieren (?) und dann die Tools die ich gefunden habe darauf anzusetzen.
Mal schauen ob das klappt.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

auf die Schnelle einen Tipp zum Kenntlichmachen der Duplikate:

Die Tabelle mit den Werten beginnt in A2, Zeiger auf A2 stellen, bedingte Formatierung / formel ist:

Code:

---

=ZÄHLENWENN($A2:$G2;A2)>1

---

Zellehintergrund rot einfärben,
A2 Format übertragen und auf die restlichen Zellen anwenden,

so sind die zellen gekennzeichnet die Duplikate enthalten.

Wenn es wenige sind - von Hand löschen

Löschen automatisch, nur per VBA oder das ganze mit einer Matrixformel in einem 2 Blatt neu aufbauen...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Mal eine Idee das ganze per VBA automatisch löschen zu lassen, sehr ausbaufähig und bei größeren Bereichen schnarchlangsam      (das erfüllt also Deine Anfangsbedingungen (2000 Zeilen, 40 Spalten) nicht wirklich)
Wer mag, bastelt das cells.value da raus, das sollte dann schon etwas helfen...

Code:

---

Option Explicit
'#####  *SCHNARCH*  Nur bis ca 10 Zeilen/Spalten erträgliche Ausführungszeit #####
Public Sub DuplikateInZeilen()
Dim arTempSpalte()  As String
Dim b As Integer
Dim Z As Integer, SA As Integer, SE As Integer, ZA As Integer, ZE As Integer
Dim i As Integer, j As Integer
Dim flag As Boolean
'###hier gibt es im Forum (Hallo Thomas      ) eine Eingabeaufforderung für
SA = 1          'oder z.B. InputBox("Start-SPALTE:" & Chr(10) & "A=1,B=2,...")
SE = 10          'InputBox("End-SPALTE:" & Chr(10) & "A=1,B=2,...")
ZA = 1          'InputBox("Start-ZEILE:")
ZE = 10          'InputBox("End-ZEILE:")
'###
For Z = ZA To ZE                                'Ablauf zeilenweise
    Erase arTempSpalte                          'array löschen, ist wichtig für Schleifenablauf
    ReDim arTempSpalte(0 To SE - SA) As String  'array neu dimensionieren
    i = 0                                      'arrayindex zurücksetzen
    For b = SA To SE                            'array wird waagerecht gefüllt
        flag = False                            'flag zurücksetzen, wichtig für Schleifenablauf
        For j = LBound(arTempSpalte()) To UBound(arTempSpalte())    'Schleife möglichst automatisiert eingrenzen
            'wenn Tabelleneintrag schon im array vorhanden ist: flag auf true setzen
            If LCase(arTempSpalte(j)) = LCase(Sheets(1).Cells(Z, b).Value) Then flag = True
        Next j
        If flag = False Then                    'wenn Tabelleneintrag erstmalig auftritt, schreib ihn ins array
            arTempSpalte(i) = Sheets(1).Cells(Z, b).Value
            i = i + 1                          'arrayindex erhöhen
        End If
    Next b
    i = 0                                      'arrayindex zurücksetzen
    For b = SA To SE
        Sheets(1).Cells(Z, b).Value = arTempSpalte(i)  'und Array zurück in Tabelle schreiben -> bereinigte Zeile
        i = i + 1
    Next b
Next Z
End Sub

---

[rredit] so ist die Ausführungszeit auch bei größeren Bereichen erträglich, Prinzip ist dasselbe, nur ohne cells.value, daher hab ich mir auch diesmal die Kommentare gespart. Andere Vorschläge bitte kundtun :-)

Code:

---

Option Explicit
Public Sub DIS()
Dim arQuell()
Dim arTemp() 'As String
Dim a As Integer, b As Integer, i As Integer, iArCount As Integer
Dim EZA As Integer, ES1 As Integer, LZA As Integer, LS1 As Integer
Dim bolDop As Boolean
EZA = 1    'Erste Zeile
ES1 = 1    'Erste Spalte
LZA = 10    'Letzte Zeile
LS1 = 5    'Letzte Spalte
arQuell = Sheets(1).Range(Cells(EZA, ES1), Cells(LZA, LS1)).Value
For a = LBound(arQuell, 1) To UBound(arQuell, 1)
    ReDim Preserve arTemp(1 To UBound(arQuell, 1), 1 To UBound(arQuell, 2))
    iArCount = 1
    For b = LBound(arQuell, 2) To UBound(arQuell, 2)
        bolDop = False
        For i = LBound(arTemp, 2) To UBound(arTemp, 2)
            If arTemp(a, i) <> "" Then If UCase(arQuell(a, b)) = UCase(arTemp(a, i)) Then bolDop = True
        Next i
        If bolDop = False Then
            arTemp(a, iArCount) = arQuell(a, b)
            iArCount = iArCount + 1
        End If
    Next b
Next a
Sheets(1).Range(Cells(EZA, ES1), Cells(LZA, LS1)) = arTemp
End Sub

---

[/rredit]
------------------
Gruß,
runkelruebe                        Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ja, genau das war es! Vielen vielen Dank runkelruebe! Einmal den Zellbereich angepasst und laufen lassen - hat zwar etwas gedauert, aber auch nicht unerträglich lange. Und da ich das ja nicht täglich brauche ist das für mich die ideale Lösung.

Vielen Dank noch einmal und Us folgen.

MfG

Chris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP