Vergleich und Löschen

hallo matthias,
noch'n versuch. dabei wird übrigens auch in deiner mittleren spalte die doppelte 5 und 6 entfernt.

Sub vergleich()
Dim EndeA As Integer, EndeB As Integer, EndeC As Integer
Dim a%, b%, c%
'Hinweis: Integer nur wenn sicher ist, dass
'Bereich nur bis Zeile 32768 = Integerende geht (z.B. EndeC / c max. 256 Spalten)
'Optimierung für größere Datenmengen mit "Find" zum Suchen
'EndeC klappt so, wenn die letzte Spalte nicht gefüllt ist
EndeC = Cells(1, Columns.Count).End(xlToLeft).Column
'alle Spalten bearbeiten ausser letzter Spalte - danach kommt nix mehr
For c = 1 To EndeC
  'letzte Zeile der bearbeiteten Spalte
  EndeA = Cells(Rows.Count, c).End(xlUp).Row
  'EndeA/B klappt so, wenn der Bereich nicht bis ganz unten gefüllt ist
  'bearbeitete Spalte von letzter zu erster Zeile durchgehen
  'Bearbeitungsspalte nach doppelten durchsuchen
  For a = EndeA To 1 Step -1
    'bei Gleichheit Zelle in bearbeiteter Spalte löschen
    For b = 1 To a - 1
      If Cells(a, c) = Cells(b, c) Then
        Cells(a, c).Delete shift:=xlUp
        EndeA = EndeA - 1
        Exit For
      End If
    Next b
  Next a
  MsgBox 1
  'nach Doppelsuche in letzter Spalte Schleife verlassen
  If c = EndeC Then Exit For

  For a = EndeA To 1 Step -1
    'mit allen Folgespalten vergleichen
    If Cells(a, c) = "" Then
      Cells(a, c).Delete shift:=xlUp
    Else
      For d = c + 1 To EndeC
        'letzte Zeile der Suchspalte
        EndeB = Cells(Rows.Count, d).End(xlUp).Row
        'mit allen Zeilen vergleichen
        For b = 1 To EndeB
          'bei Gleichheit Zelle in bearbeiteter Spalte löschen
          If Cells(a, c) = Cells(b, d) Then
            Cells(a, c).Delete shift:=xlUp
            Exit For
          End If
        Next b
      Next d
    End If
  Next a
Next c
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

gruss andre

Sub vergleich() Dim EndeA As Integer, EndeB As Integer EndeA = Range("A1").End(xlDown).Row EndeB = Range("B1").End(xlDown).Row For B = 1 To EndeB For A = 1 To EndeA If Cells(A, 1) = Cells(B, 2) Then Cells(A, 1).Delete End If Next A Next B End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
erst mal vielen vielen Dank für die Hilfe. Andre, das Programm ist so wie ich es beschrieben habe, aber Rainer hat recht, ich habe mich unpräzise ausgedrückt bzw. war mir nicht klar über den genauen Ablauf.
Es wäre perfekt, wenn
wenn Spalte B; die Spalte A überprüft ob gleiche Zahlen vorhanden, wenn in A gleiche Zahlen vorhanden dann diese in Spalte A löschen und darunter liegende Zahlen hochrücken
wenn Spalte C; die Spalte B und die Spalte A überprüft ob gleiche Zahlen vorhanden, wenn in B und oder A gleiche Zahlen vorhanden dann diese in Spalte A bzw B löschen und darunter liegende Zahlen hochrücken
wenn Spalte D; die Spalte C, die Spalte B und die Spalte A überprüft ob gleiche Zahlen vorhanden, wenn in C und oder B und oder A gleiche Zahlen vorhanden dann diese in Spalte A bzw. B bzw. C löschen und darunter liegende Zahlen hochrücken.
usw.
Doppelungen bzw. mehr als Doppelungen in den Spalten wollte ich mit einem gesonderten Makro beseitigen, wenn es in einem Makro geht, wäre das super.
Mit der EXCEL Datei und dem Makro wollte ich eine Auftragsverfolgung realisieren, in der die jeweilige bearbeitende Station die Auftragsnummer einscannt und die Nummer an den vorherigen Stationen löscht, da sie dort dann ja fertig bearbeitet sind.
Nochmals vielen Dank für die Mühe. Sollte jemand von Euch mal in Potsdam sein, melden ich gebe einen aus. Das ist wirklich ernst gemeint.
Viele Grüße Matthias

Beliebteste Forumthreads (12 Monate)

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread