AW: Daten vergleichen
12.02.2014 16:14:53
fcs
Hallo Altun,
hier mal ein Anlauf für die Umsetzung.
Teste es mal mit einer Kopie der Masterdatei.
Das Makro kannst du entweder in die Masterdatei einbauen oder in deine persönliche Makroarbeitsmappe.
Beim Start des Makros muss die Masterdatei geöffnet und die aktive Arbeitsmappe sein.
Die Datei mit den neuen Daten sollte geschlossen sein. Sie wird vom Makro in einem Dialog abgefragt.
Gruß
Franz
Sub Import_Interchange()
Dim wkbMaster As Workbook, wkbNeu As Workbook, varAuswahl
Dim wksMaster As Worksheet, wksNeu As Worksheet
Dim ZeileMaster As Long, ZeileNeu As Long
Dim varMake, varModel, varYear
Dim varInterchangeNeu, varInterchangeAlt
Dim SpalteNeu As Long, SpalteMaster As Long
Dim bolGefunden As Boolean
varAuswahl = Application.GetOpenFilename( _
Title:="Bitte Datei mit neuen Teilenummern auswählen")
If varAuswahl = False Then Exit Sub
Set wkbMaster = ActiveWorkbook
Set wksMaster = wkbMaster.Worksheets(1) 'oder .Worksheets("TabellenName")
Set wkbNeu = Application.Workbooks.Open(Filename:=varAuswahl, ReadOnly:=True)
Set wksNeu = wkbNeu.Worksheets(1) 'oder .Worksheets("TabellenName")
With wksMaster
SpalteMaster = .Cells(1, .Columns.Count).End(xlToLeft).Column
varInterchangeAlt = .Cells(1, SpalteMaster).Value
End With
With wksNeu
SpalteNeu = .Cells(1, .Columns.Count).End(xlToLeft).Column
varInterchangeNeu = .Cells(1, SpalteNeu).Value
End With
If varInterchangeNeu = varInterchangeAlt Then
MsgBox "Die Teilespalte """ & varInterchangeNeu & """ ist im Master schon vorhanden"
Else
SpalteMaster = SpalteMaster + 1
wksMaster.Cells(1, SpalteMaster) = varInterchangeNeu
With wksNeu
'Zeilen in neuer Interchange-Dtaei abarbeiten
For ZeileNeu = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Marke, Model und Jahr für Vergleich merken
varMake = .Cells(ZeileNeu, 2).Value
varModel = .Cells(ZeileNeu, 3).Value
varYear = .Cells(ZeileNeu, 4).Value
If .Cells(ZeileNeu, SpalteNeu) "" Then
'neue Interchange-Spalte enthält Daten
bolGefunden = False
With wksMaster
For ZeileMaster = 3 To .Cells(.Rows.Count, 2).End(xlUp).Row
If varMake = .Cells(ZeileMaster, 2).Value Then
If varModel = .Cells(ZeileMaster, 3).Value Then
If varYear = .Cells(ZeileMaster, 4).Value Then
bolGefunden = True
.Cells(ZeileMaster, SpalteMaster) = wksNeu.Cells(ZeileNeu, SpalteNeu)
Exit For
End If
End If
End If
Next ZeileMaster
If bolGefunden = False Then
'Neues Modell in Liste
With .Cells(.Rows.Count, 1).End(xlUp)
'Nummer in nächster Zeile 1 hochzählen
.Offset(1, 0).Value = .Value + 1
'alle neuen Daten kopieren
wksNeu.Range(wksNeu.Cells(ZeileNeu, 2), _
wksNeu.Cells(ZeileNeu, SpalteNeu - 1)).Copy Destination:=.Offset(1, 1)
'aktuelle interchangespalte asufüllen
.Offset(1, SpalteNeu - 1).Value = wksNeu.Cells(ZeileNeu, SpalteNeu).Value
End With
End If
End With 'wksMaster
End If
Next ZeileNeu
End With 'wksNeu
End If
End Sub