AW: Abgleich von Tabellen und ausgebe doppelter werte
13.10.2014 07:48:33
Tabellen
Hallo Daniel,
hier ein Makro zum Ausfüllen des Reportblattes.
Gruß
Franz
Sub Report_ausfuellen()
Dim wksCSV As Worksheet
Dim wksBasis As Worksheet
Dim wksReport As Worksheet
Dim varBasis As Variant, ZelleCSV As Range, rngSuchen As Range
Dim ZeileReport As Long, ZeileBasis As Long
'Tabellen-Objekte setzen
Set wksReport = ActiveWorkbook.Worksheets("Report")
Set wksBasis = ActiveWorkbook.Worksheets("Basis")
Set wksCSV = ActiveWorkbook.Worksheets("CSV")
'Alte Werte in Report löschen
With wksReport
'letzte Zeile im Report (Total-Zeile)
ZeileReport = .Cells(.Rows.Count, 1).End(xlUp).Row
'Inhalte von Zeile 5 bis oberhalb Total-Zeile löschen
.Range(.Cells(5, 1), .Cells(ZeileReport - 1, 2)).ClearContents
ZeileReport = 5
End With
'Suchbereich in CSV-Daten setzen
With wksCSV
Set rngSuchen = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'Werte in Basis abarbeiten
With wksBasis
For ZeileBasis = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
varBasis = .Cells(ZeileBasis, 1).Value
If varBasis "" Then
Set ZelleCSV = rngSuchen.Find(what:=varBasis, LookIn:=xlValues, lookat:=xlWhole) _
If Not ZelleCSV Is Nothing Then
wksReport.Cells(ZeileReport, 1) = varBasis
wksReport.Cells(ZeileReport, 2) = ZelleCSV.Offset(0, 1).Value
ZeileReport = ZeileReport + 1
End If
End If
Next
End With
End Sub