Datenpool mit Excel aufbauen?

Hallo,
unser Kunde schickt uns jeden 2.Tag eine xls-Datei, mit seinen aktuellen Werten.
Ich würde gerne einen Datenpool in Excel aufbauen.
Einen aktuellen Datenbestand hätte ich bereits in der Mappe "aktueller Datenbestand". Hier sind alle bisher geschickten Daten vom Kunden drin.
Die Daten die nun jeden 2. Tag kommen liegen in der gleichen xls im Tabellenblatt "Import".
Diesen Inhalt muss ich jetzt in "aktueller Datenbestand" einfließen lassen.
Zum Aufbau der Datei:
Insgesamt 120 Spalten.
Folgende Logik:
Das wichtigsten Feld (Schlüssel) ist immer die Vertragsnummer (die Spalte heißt Vernr).
Und zudem sollen nur die Daten aus Tabellenblatt "Import" angeschaut werden die in der Spalte "Status" den Wert "OK" haben.
1.)Neuanlage:
Wenn Vernr aus "Import" nicht in "aktueller Datenbestand" enthalten ist: dann füge die komplette Zeile aus Tabellenblatt "Import" in "aktueller Datenbestand".
2.)Update:
Wenn Vernr aus "Import" in "aktueller Datenbestand" vorhanden ist: dann überschreib die Zeile mit der Vernr in "aktueller Datenbestand" mit dem Datensatz aus Tabellenblatt "Import".
Das wäre der erste Step.
Optimal wäre natürlich in einem nachfolgenden Schritt zu wissen welcher Inhalt hat sich den aktualisiert beim Fall Update.
Ist sowas möglich?:
Wenn Neuanlage dann schreibe zum jeweiligen Datensatz in die erste freie Spalte "NEUANLAGE" im Tabellenblatt "aktueller Datenbestand"
Wenn Update dann schreiben alle Spaltenüberschriften wo sich der Inhalt geändert hat in die erste freie Spalte im Tabellenblatt ""aktueller Datenbestand" des jeweiligen Datensatzes. (z.B.: Anschrift, Telefonnummer, Ansprechpartner etc.) Es reicht also nur die Aufzählung welche Spalten sich geändert haben, die Werte an sich würde ich dann selber raussuchen.
Ist sowas überhaupt in Excel machbar, das er 120 Spalten nach der kleinsten Abweichung ausgibt?
Ich hoffe Ihr könnt mich hier unterstützten.
Gruß
Julia
P.S. Das Ergebnis wäre dann: der Kunde schickt seine Daten. Diese stehen dann im Tabellenblatt "Import" daraus wird durch uns das Tabellenblatt "aktueller Datenbestand" geupdated.
Diese Datei ist speicher ich ab. Bei der Nächsten Lieferung wird dann das Tabellenblatt "Import mit den neuen "Daten des Kunden bestückt.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub ImportData() Dim wksImp As Worksheet, wksDat As Worksheet Dim hshId As Object Dim lngLR&, lngRow&, i&, j& Dim strId$ Dim blnDiff As Boolean Const lngCOLID As Long = 1 'Spalte-Nr. mit "Vernr" Const lngCOLSTAT As Long = 30 'Spalte-Nr. mit "Status" Const lngCOLCNT As Long = 30 'Anzahl Spalten Set wksImp = ThisWorkbook.Sheets("Import") Set wksDat = ThisWorkbook.Sheets("aktueller Datenbestand") Set hshId = CreateObject("Scripting.Dictionary") With wksImp For i = 2 To wksDat.Cells(.Rows.Count, 1).End(xlUp).Row hshId(wksDat.Cells(i, lngCOLID).Text) = i Next For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row blnDiff = False If .Cells(i, lngCOLSTAT) = "OK" Then strId = .Cells(i, lngCOLID).Text If hshId.Exists(strId) Then lngRow = hshId(strId) For j = 1 To lngCOLCNT 'hier könnstest du die Unterschiede auslesen und verarbeiten 'Der Einfachheit halber hier nur Schalter für "update" gesetzt. If .Cells(i, j) wksDat.Cells(lngRow, j) Then blnDiff = True Exit For End If Next If blnDiff Then wksDat.Cells(lngRow, lngCOLCNT + 1) = "update" wksDat.Cells(lngRow, lngCOLCNT + 2) = Now wksDat.Cells(lngRow, 1).Resize(, lngCOLCNT) = _ .Cells(i, 1).Resize(, lngCOLCNT).Value End If Else lngLR = wksDat.Cells(Rows.Count, 1).End(xlUp).Row wksDat.Cells(lngLR + 1, lngCOLCNT + 1) = "new" wksDat.Cells(lngLR + 1, lngCOLCNT + 2) = Now wksDat.Cells(lngLR + 1, 1).Resize(, lngCOLCNT) = _ .Cells(i, 1).Resize(, lngCOLCNT).Value End If End If Next End With Set hshId = Nothing Set wksImp = Nothing Set wksDat = Nothing End Sub

Hallo Julia,
nachdem ich meine Lösung kurz nach Christian fertig hatte will ich sie dir auch nicht vorenthalten.
Der Ansatz ist sehr ähnlich zu Christians Lösung. Zur Prüfung ob eine Vertrags-Nr. schon vorhanden verwende ich jedoch die Find-Funktion. Die mit der letzten Änderung geänderten Daten werden mit roter Schrift dargestellt.
Gruß
Franz

Sub a1_UpdateBestand()
Dim wksImp As Worksheet, ZeileImp As Long, Spalte As Long
Dim wksBest As Worksheet, ZeileBest As Long
Dim SpUpdate As Long, SpAenderung As Long, SpFelder As Long
Dim varVerNr As Variant, rngVerNr As Range
Dim boolMark As Boolean
Const SpVerNr As Long = 1         'Spalte mit Vertrags-Nummer   'anpassen!
Const SpStatus As Long = 2        'Spalte mit Status            'anpassen!
Const SpAnzahl As Long = 120      'Anzahl der Spalten mit Daten 'ggf. anpassen
Set wksImp = Worksheets("Import")
Set wksBest = Worksheets("aktueller Datenbestand")
'Spaltennummern der Spalten für die zusätzlichen Einträge - ggf. anpassen
SpUpdate = SpAnzahl + 1         'NEUANLAGE/UPDATE
SpAenderung = SpUpdate + 1      'Datum der letzten Änderung
SpFelder = SpAenderung + 1      'Liste der geänderten Spalten
With wksBest
'Alt-Einträge in Spalte Update/Neu löschen
ZeileBest = .Cells(.Rows.Count, SpVerNr).End(xlUp).Row
If ZeileBest > 1 Then
.Range(.Cells(2, SpUpdate), .Cells(ZeileBest, SpUpdate)).ClearContents
End If
End With
With wksImp
Application.ScreenUpdating = False
For ZeileImp = 2 To .Cells(.Rows.Count, SpVerNr).End(xlUp).Row
If UCase(.Cells(ZeileImp, SpStatus).Value) = "OK" Then
varVerNr = .Cells(ZeileImp, SpVerNr).Value
With wksBest
'Zeile mit Vertragsnummer im aktuellen Bestand suchen
Set rngVerNr = .Range(.Cells(2, SpVerNr), .Cells(.Rows.Count, SpVerNr)).Find _
(What:=varVerNr, LookIn:=xlValues, lookat:=xlWhole)
If rngVerNr Is Nothing Then
'Neue Vertragsnummer
ZeileBest = .Cells(.Rows.Count, SpVerNr).End(xlUp).Row + 1
.Cells(ZeileBest, SpUpdate).Value = "NEUANLAGE"
.Cells(ZeileBest, SpAenderung).Value = Date
For Spalte = 1 To SpAnzahl
.Cells(ZeileBest, Spalte).Value = wksImp.Cells(ZeileImp, Spalte).Value
Next
Else
'bestehende Vertragsnummer prüfen und ggf. aktualiseren
boolMark = False 'Merker für Änderungen an Vertragsnummer zurücksetzen
ZeileBest = rngVerNr.Row
For Spalte = 1 To SpAnzahl
If .Cells(ZeileBest, Spalte).Value  wksImp.Cells(ZeileImp, Spalte).Value Then
If boolMark = False Then
'Zeile wegen Änderungen markieren und Daten des letzten Updates zurücksetzen/ü _
berschreiben
.Cells(ZeileBest, SpUpdate).Value = "UPDATE"
.Cells(ZeileBest, SpAenderung).Value = Date
.Cells(ZeileBest, SpFelder).Value = "" 'Spalten des vorherigen Updates lö _
schen
.Rows(ZeileBest).Font.ColorIndex = xlAutomatic 'Schriftfarbe in Zeile zurü _
cksetzen
boolMark = True 'Merker, dass Daten zur Vertragsnummer geändert wurden
End If
With .Cells(ZeileBest, Spalte)
'alten Wert überschreiben
.Value = wksImp.Cells(ZeileImp, Spalte).Value
'Schrift in Rot ändern
.Font.ColorIndex = 3
End With
'geänderte Spalte in Zusatzspalte ergänzen
With .Cells(ZeileBest, SpFelder)
If .Value = "" Then
.Value = wksBest.Cells(1, Spalte).Value
Else
.Value = .Value & " | " & wksBest.Cells(1, Spalte).Value
End If
End With
End If
Next Spalte
End If
End With
End If
Next ZeileImp
Application.ScreenUpdating = True
End With
MsgBox "Fertig", vbInformation + vbOKOnly, "Import im Bestand aktualisieren"
End Sub

Beliebteste Forumthreads (12 Monate)

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