Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1152to1156
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

nur neue Daten importieren

nur neue Daten importieren
Werner
Hallo!
Trotz Suche finde ich keine Lösung für mein Problem (oder ich bin blind)...
Ich möchte Daten aus einem bestimmten Blatt von Datei 1 in ein best. Blatt von Datei 2 importieren.
Die Daten und Formatierungen usw. in Datei 2 sollen aber beibehalten werden.
Doppelte Einträge sollen nicht importiert werden. Also nur was Neu ist soll kopiert werden.
Das muss doch machbar sein?!
Gruß und Danke!!!
Werner

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
Tabellen vergleichen - neue Daten importieren
23.04.2010 08:39:09
fcs
Hallo Werner,
der Vergleich und die Aktualisierung von Daten sind nur dann möglich, wenn für den Vergleich eindeutige Kriterien vorhanden sind. Im Idealfall gibt es eine Spalte mit einem eindeutigen Schlüssel im ungünstigsten Fall muss man alle Spalten jeder Zeile vergleichen/durchsuchen um neue Daten zu identifizieren.
Nachfolgend zwei Beispielmakros.
Gruß
Franz
Sub Datenabgleich_Spalten()
'Daten aus zwei Tabellen abgleichen - mehrere/alle Spalten vergleichen
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long, Zelle As Range
Dim ZeileQuelle As Long, ZeileZiel As Long, Spalte As Long
Dim strAdresse1 As String, bIdentisch As Boolean
'Datei/Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks("MappeDaten.xls") 'Name anpassen!
Set wksQuelle = wbQuelle.Worksheets("Tabelle2") 'Name - anpassen
'Datei/Tabelle in der Inhalte eingetragen werden sollen
Set wbZiel = Workbooks("MappeZiel.xls") 'Name anpassen!
Set wksZiel = wbZiel.Worksheets("Tabelle1") 'Name - anpassen
'Nr. der Spalte mit dem Hauptkriterium
lSpalteSchluessel = 1                       'ggf Anpassen
'Letzte Datenzeile in Zieltabelle
With wksZiel
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
End With
Application.ScreenUpdating = False
With wksQuelle
For ZeileQuelle = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(ZeileQuelle, lSpalteSchluessel)
'Begriff in Spalte Schlüsselspalte im Zieltabelle suchen
Set Zelle = wksZiel.Columns(lSpalteSchluessel).Find(what:=varSchluessel, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then 'neuer Datensatz
bIdentisch = False
Else
'Adresse der 1. Fundstelle merken
strAdresse1 = Zelle.Address
Do
bIdentisch = True
'Prüfen ob die anderen Werte auch übereinstimmen
For Spalte = 1 To 6                         'ggf. anpassen
'zuvergleichende SPalten festlegen
Select Case Spalte
Case 1 To 6                              'ggf. anpassen
If wksZiel.Cells(Zelle.Row, Spalte)  .Cells(ZeileQuelle, Spalte) Then
bIdentisch = False
Exit For
End If
Case Else
'Spalte überspringen
End Select
Next
If bIdentisch = True Then Exit Do
'Nächsten Namens-Eintrag suchen
Set Zelle = wksZiel.Columns(lSpalteSchluessel).FindNext(after:=Zelle)
Loop Until Zelle.Address = strAdresse1
End If
If bIdentisch = False Then
'neuen Datensatz übertragen
ZeileZiel = ZeileZiel + 1
.Rows(ZeileQuelle).Copy
wksZiel.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
End Sub
Sub Datenabgleich_Schluessel()
'Daten aus zwei Tabellen abgleichen per Schlüsselspalte
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long, Zelle As Range
Dim ZeileQuelle As Long, ZeileZiel As Long
'Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks("MappeDaten.xls") 'Name anpassen!
Set wksQuelle = wbQuelle.Worksheets("Tabelle2") 'Name - anpassen
'Tabelle in der Inhalte eingetragen werden sollen
Set wbZiel = Workbooks("MappeZiel.xls") 'Name anpassen!
Set wksZiel = wbZiel.Worksheets("Tabelle1") 'Name - anpassen
'Nr. der Schlüsselspalte
lSpalteSchluessel = 1 'ggf Anpassen
'Letzte Datenzeile in Zieltabelle
With wksZiel
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
End With
Application.ScreenUpdating = False
With wksQuelle
For ZeileQuelle = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(ZeileQuelle, lSpalteSchluessel)
'Name in Spalte Schlüsselsüalte im Zieltabelle suchen
Set Zelle = wksZiel.Columns(lSpalteSchluessel).Find(what:=varSchluessel, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then 'neuer Datensatz
ZeileZiel = ZeileZiel + 1
.Rows(ZeileQuelle).Copy
wksZiel.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
Else
'do nothing - keine bestehenden DAten ändern
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige