Makro für Vergleich von Zellen gesucht

[Keik940]

Liebes Excel-Forum,

ich habe eine Tabelle mit 40.000 Zeilen, die ich in den vergangenen 6 Monaten bearbeitet habe. Dort habe ich mehrfach zwischendurch nach den Farben einzelner Zellen gefiltert, was die Reihenfolge der einzelnen Zellen zerstört hat (das bei Excel dieses Problem öfter auftaucht, wusste ich vorher nicht). Ich brauche aber die ursprüngliche Zeilenreihenfolge zurück.

Nun kann ich nicht diese Masse an Daten wieder zurücksortieren und brauche dafür eine Programmierung. Dazu habe ich eine Beispiel-Excel angehangen.

Ich habe noch die Originaldatei von vor 6 Monaten mit der Zeilenreihenfolge, so wie sie sein soll (Tabellenblatt "richtig") und die Excel mit den durch die Filterung umsortierten Zeilen (Tabellenblatt "falsch").

In Spalte A habe ich in der Excel "richtig" die Zeilen durchnummeriert. Ich benötige nun ein Makro (oder eine Formel) welches die beiden Blätter untereinander vergleicht und wenn Zeilen 100% übereinstimmen im Blatt "falsch" die entsprechende Zeilennummer aus Blatt "richtig" in Spalte A einträgt, so dass ich am Schluss die Zeilen einfach nach der Größe aufsteigen sortieren kann und somit die alte Reihenfolge wiederhabe.

Wichtig: In den Spalten B, C, F, L, Q, R (gelb markiert) gibt es untereinander Abweichungen durch meine Bearbeitung. Diese Spalten sollen demnach nicht in den Vergleich der einzelnen Zeilen mit einbezogen werden.

Seht ihr das als den richtigen Lösungsweg und habt ihr dafür eine entsprechende Programmierung?

Vielen Dank schon einmal für eure Hilfe!

KEIK

[Fennek]

Hallo Katja,

als Ansatz:

in beiden Blättern eine Hilfsspalte, die alle für den Vergleich notwendigen Spalten konkadiniert (falls es das auf deutsch gibt). Danach kann man mit einem "=Sverweis" die "richtige" Zeilennummer in die "falsche" Liste einpflegen.

mfg

[Keik940]

Hallo Fennek,

ich habe es bereits über SVerweis versucht aber nur für eine Spalte. Dies führte dazu, dass manche Ergebnisse doppelt vorkamen, da mit nur einer Spalte keine eineindeutige Zuordnung gewährleistet ist.

Ich scheitere leider genau an dem Begriff "konkadiniert". Was ist damit gemeint?

Viele Grüße

[Fennek]

Hallo,

in xl365 gibt es (engl) "=concadinate(...)", älteren Version einfach in einer freien Spalte "=A1 & "|" & B1 & "|" usw)

Da ist recht viel Tiparbeit und bei so vielen Zeilen darf der PC nicht zu schwach sein.

mfg

(Konkadinieren = Zellen verbinden)

[Gast 123]

Hallo

da ein Makro gewünscht wurde hier eine Löung.  Bei 40.000 Daten kann das lange daueren, weil 31 oder 38 Spalten verglichen werden müssen.  Mir fiel auf das im Beispiel ab Spalte AE keine Daten mehr kommen.  Ist das richtig??  Die Daten von "W" bis "Z" kommen nur einmal vor, ohne doppelte!  Stimmt das??  

Ich vergleich zuerst Spalte W!  Dann prüfe ich alle Zeilen ab "D" bis zur letzten Spalte, ohne die gelben Spalten 2,3,6,12,17,18
Würde mich freuen wenn es klappt.  Die aktuelle Zeile wird zur Kontrolle im Statusfeld angezeigt.

mfg  Gast 123

Code:

Option Explicit         '24.10.2018  für  Clever Forum
Const LastSpalte = 31   '31 oder 38 Spalten

'2,3, 6, 12, 17,18    nicht auswerten!!
'31 oder 38 Spalten   AE oder AL letzte?
'Spalte 23-26  W bis Z  Keine doppelten?


Sub Spalten_vergleichen()
Dim fe As Long, nF As Long, STxt
Dim j As Long, Txt As String
Dim f As Integer, n As Integer
Dim AC As Range, rFind As Range
Dim RSht As Worksheet, lz As Long
Set RSht = Worksheets("richtig")

Application.ScreenUpdating = False
STxt = Application.StatusBar

With Worksheets("falsch")
  .Select   'Tabelle aktivieren
  'LastZell in "falsch" ermitteln
  lz = .Cells(Rows.Count, 2).End(xlUp).Row
  'Spalte A in "falsch" Tabelle löschen
  .Range("A2:A" & lz).ClearContents
 
  'Schleife zum Suchen in Spalte "W"
  For Each AC In .Range("W2:W" & lz)
      Application.StatusBar = AC.Row
      Set rFind = RSht.Columns("W").Find(What:=AC, After:=Range("W2"), LookIn:= _
          xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
     
      'Fehlermeldung bei: Wert in "W" "No Find"
      If rFind Is Nothing Then
         .Cells(AC.Row, 1) = "No Find"
          nF = nF + 1  'No Find Zaehler
      End If
     
      If Not rFind Is Nothing Then
         n = 0   'n= Spaltenzaehler
         f = 0   'f = Fehlerzaehler
         '31 oder 38 Spalten vergleichen
         For j = 4 To LastSpalte
            If j = 6 Or j = 12 Or j = 17 Or j = 18 Then
            ElseIf .Cells(AC.Row, j) = RSht.Cells(rFind.Row, j) Then
                n = n + 1
            Else: f = f + 1:  fe = fe + 1
            End If
         Next j
         
         'Vergleich Auswertung:
         If LastSpalte = 31 And n = 24 Then
            .Cells(AC.Row, 1) = RSht.Cells(rFind.Row, 1)
         ElseIf LastSpalte = 38 And n = 31 Then
            .Cells(AC.Row, 1) = RSht.Cells(rFind.Row, 1)
         Else
            .Cells(AC.Row, 1) = f & " <> Verify"
         End If
      End If
  Next AC

  If fe > 0 Then Txt = fe & "  <>  Verify"
  If nF > 0 Then Txt = Txt & Chr(10) & nF & "  Zeilen  No Find"
  If Txt <> "" Then MsgBox Txt

  Application.StatusBar = STxt
End With
End Sub