AW: Datensätze aus 2 Tabellen vergleichen
01.05.2008 00:15:22
Daniel
Hi
das Problem ist, daß du überflüssigerweise eine neue Excelinstanz aufmachst, um die Importdatei zu öffnen, und ich nicht so genau weiß, wie man damit umgeht.
Wahrscheinlich gibts mit der Worksheetfunction in verbindung mit der neuen Excelinstanz ein Problem.
Öffne die Datei doch einfach ganz normal, dann funktioniert auch das Makro:
Sub DatenImportieren()
Dim Zähler As Long, Bereich As Long
Dim Zelle As Range, EinFüg As Long, B As Long
Dim wb As Workbook
On Error GoTo Fehler:
Application.ScreenUpdating = False
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Import_neu.xls")
Zähler = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For Bereich = 2 To Zähler
'Suche Nr. in Tabelle Daten
Set Zelle = Range("A2:" & Cells(Rows.Count, 1).End(xlUp).Address). _
Find(What:=wb.Sheets(1).Cells(Bereich, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
'Prüfe ob Nr. vorhanden
If Zelle Is Nothing Then
EinFüg = Cells(Rows.Count, 1).End(xlUp).Row + 1
'Daten schreiben
For B = 1 To wb.Sheets(1).Cells(Bereich, Columns.Count).End(xlToLeft).Column
If wb.Sheets(1).Cells(Bereich, B) > "" Then
Cells(EinFüg, B).Value = wb.Sheets(1).Cells(Bereich, B).Value
End If
Next B
End If
Next Bereich
With ThisWorkbook.Sheets("Tabelle1")
Zähler = .Cells(Rows.Count, 1).End(xlUp).Row
For Bereich = 2 To Zähler
If WorksheetFunction.CountIf(wb.Sheets(1).Columns(1), .Cells(Bereich, 1)) = 0 Then
.Cells(Bereich, 4).Value = "erledigt"
End If
Next Bereich
End With
Fehler:
On Error Resume Next
wb.Close
On Error GoTo 0
Application.ScreenUpdating = True
Set Zelle = Nothing
End Sub
Gruß, Daniel