Excelmappen vergleichen und ergänzen

Hallo Forum,
ich sitze jetzt schon seid längerer Zeit vor einem Probleme und habe mir gedacht, dass ihr mir vielleicht helfen könnt. *hoff*
Ich habe eine Excel Mappe in der Kundendaten gespeichert sind die ich gerne auswerten würde. (ein Eintrag = eine Zeile)
Spalte B, Datum
Spalte C, Nachname
Spalte D, Vorname
Spalte E, Rufnummer
Spalte F, Info
Spalte G, Geburtsdatum
Jetzt möchte ich das Excel durch alle Tabellen-Mappen geht und mir die einzelnen Kunden heraus schreibt, diese sind nämlich mit großer Wahrscheinlichkeit mehrmals enthalten.
Excel soll aber das Ganze nach der Rufnummer ordnen.
Also wenn ein Eintrag doppelt vorhanden ist, z.B. die Rufnummer 012-123456 und nur bei einem Eintrag eine Info existiert, soll Excel mir nur diesen Eintrag mit der Info auswerfen.
So und weil es noch nicht schwer genug ist geht es weiter.
Sagen wir, bei unserem ersten Eintrag, wo die Rufnummer und die Info existiert, fehlt uns nun das Geburtsdatum.
Diese Information ist in dem Eintrag, wo die Info fehlt, Excel soll dies in den ersten Eintrag ergänzen und mir auch nur diesen einen kompletten Eintrag ausgeben.
So das ich zum Schluss einen Kunden habe, mit hoffentlich allen relevanten Daten, wenn sie vorhanden sind.
Ich hoffe ihr blickt bei meiner Beschreibung durch und könnt mir helfen.
Bis denne
Phyrox :O)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Phyrox,
folgende Routine nimmt sich die erste Arbeitsmappe und vergleicht Sie erst mit der 2., dann mit der 3.
Wenn eine Übereinstimmung in der Telefonnummer erkannt wird, werden die einzelnen Zellen der Zeile verglichen. Steht in dem 1. Tabellenblatt nichts und im 2. oder 3. steht was, wird es in das 1. geschrieben.
So wird in dem . Tabellenblatt alle infos aus den folgenden gesmmelt.
Gruß
Fritz
Option Explicit
Dim I&, J&, X&
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Dim LZ1&, LZ2&, LZ3& 'LZ=LetzteZeile
Dim LS1&, LS2&, LS3& 'LS=LetzteSpalte


Sub Vergleichen()
Set Ws1 = Worksheets(1)
Set Ws2 = Worksheets(2)
Set Ws3 = Worksheets(3)
LZ1 = Ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
LZ2 = Ws2.Cells.SpecialCells(xlCellTypeLastCell).Row
LZ3 = Ws3.Cells.SpecialCells(xlCellTypeLastCell).Row
LS1 = Ws1.Cells.SpecialCells(xlCellTypeLastCell).Column
LS2 = Ws2.Cells.SpecialCells(xlCellTypeLastCell).Column
LS3 = Ws3.Cells.SpecialCells(xlCellTypeLastCell).Column
For I = 2 To LZ1
For J = 2 To LZ2
If Ws1.Cells(I, 5) = Ws2.Cells(J, 5) Then
For X = 1 To LS1
If Ws1.Cells(I, X) = "" Then
If Ws2.Cells(J, X) <> "" Then
Ws1.Cells(I, X) = Ws2.Cells(J, X)
End If
End If
Next
End If
Next
For J = 2 To LZ3
If Ws1.Cells(I, 5) = Ws3.Cells(J, 5) Then
For X = 1 To LS1
If Ws1.Cells(I, X) = "" Then
If Ws3.Cells(J, X) <> "" Then
Ws1.Cells(I, X) = Ws3.Cells(J, X)
End If
End If
Next
End If
Next
Next
End Sub

Beliebteste Forumthreads (12 Monate)

Excelmappen vergleichen und ergänzen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread