AW: Suchen/Vergleichen/Informieren
12.01.2012 19:37:47
fcs
Hallo Karsten,
der Abgleich funktioniert mit folgendem Makro. Die Fahrgestellnummern dürfen jedoch nicht mehrfach in der Altdatei vorkommen, damit es korrekt funktioniert.
Es werden in dieser Version immer alle Zeilen der neuen Datei mit der Alt-Datei abgeglichen.
Gruß
Franz
Sub AlteFahrGestellNr_abgleichen()
Dim wbNeu As Workbook, wksNeu As Worksheet
Dim wbAlt As Workbook, wksAlt As Worksheet, strNameAlt As String, rngAlt As Range
Dim lngZeile As Long, lngZeileStart As Long
Dim varSuchen As Variant, lngSpalte As Integer
Dim rngSuchen As Range
Set wbNeu = ActiveWorkbook
Set wksNeu = wbNeu.Worksheets(1) 'ggf. anpassen
wksNeu.Activate
lngZeileStart = 2 'Zeile ab der die Fahrgestell-Nrn abgeglichen werden sollen
strNameAlt = "C:\Users\Public\Test\DateiAlt.xls" 'anpassen - Name der Altdatei muss _
verschieden von der neuen Datei sein !!
'Altdatei öffnen
Set wbAlt = Workbooks.Open(Filename:=strNameAlt, ReadOnly:=True)
Set wksAlt = wbAlt.Worksheets(1) 'ggf. anpassen
With wksAlt
lngZeile = .Cells.SpecialCells(xlCellTypeLastCell).Row
'Zellbereich in Altdatei, der durchsucht werden soll - hier Spalten C bis E
Set rngAlt = .Range(.Cells(2, 3), .Cells(lngZeile, 5))
End With
Application.ScreenUpdating = False
With wksNeu
'Zeilen in neuer Datei abarbeiten
lngZeile = .Cells.SpecialCells(xlCellTypeLastCell).Row
For lngZeile = lngZeileStart To lngZeile
For lngSpalte = 3 To 5 'Spalte C bis E - Spalten mit den Fahrgestell-Nrn.
varSuchen = .Cells(lngZeile, lngSpalte).Value
If varSuchen "" Then
'Suchbegriff in Altdatei suchen
Set rngSuchen = rngAlt.Find(what:=varSuchen, LookIn:=xlValues, lookat:=xlWhole)
If Not rngSuchen Is Nothing Then
'Vermerk aus Spalte A der Alt-Datei in Spalte F der Neu-Datei übertragen
wksNeu.Cells(lngZeile, 6).Value = wksAlt.Cells(rngSuchen.Row, 1).Value
Exit For
End If
End If
Next
Next
End With
'Altdatei wieder schliessen
wbAlt.Close savechanges:=False
Application.ScreenUpdating = True
MsgBox "Abgleich mit Altdatei ist abgeschlossen", vbInformation + vbOKOnly, _
"Ableich Fahrgestellnummern"
End Sub