VBA Probleme bei csv Import
22.02.2022 16:26:48
Setre
ich stehe vor folgendem Problem:
Ich möchte aus einer csv Datei, die eine Personenliste mit verschiedenen Infos enthält, diese Daten in Excel kopieren und dann in weiteren Spalten Zusatzinformationen sozusagen "per Hand" nachtragen. Die Personenliste ändert sich jeden Tag, manche Personen bleiben, andere sind nicht mehr auf der Liste, manchmal kommen neue hinzu. Jede Person auf der Liste hat eine einmalige, individuelle Nummer.
Ich habe das Programm aktuell so aufgebaut:
Die CSV Daten werden aus einem gesonderten Arbeitsblatt in die Spalten A-J kopiert.
In den Spalten K-N habe ich bestimmte Daten aus den Spalten A-J mit Excelformeln übernommen (Im finalen Ausdruck blende ich dann Spalten A-J aus).
In den Spalten O-T befinden sich zu jeder Person (jede Person ist eine Zeile) bestimmte Zusatzinformationen, die ich per Hand aus einem anderen Programm eintragen muss.
Das Makro kann aktuell, wenn eine neue CSV Datei importiert wird, überprüfen, ob die Fallnummer in der Spalte F identisch ist mit der schon gespeicherten und kopiert nur bei Änderungen, und die Zusatzinfos aus Spalten O-T werden dann gelöscht.
Wenn jetzt aber in der Ursprungsdatei eine Person aus der Mitte der Liste gelöscht wird, und alle anderen sozusagen hoch rutschen, funktioniert das Makro nicht mehr, weil dann darunter auch wieder "alte" Personen importiert werden und die Zusatzinfos gelöscht werden, obwohl die Personen sozusagen nur um eine Zeile verrutscht sind.
Nun habe ich zwei Fragen:
1: Wie kann ich Excel klarmachen, dass die nachgetragenen Zusatzinfos aus Spalten O-T zu genau dieser Fallnummer aus der entsprechenden Zeile gehören?
2: Kann ich mein Makro abändern, dass quasi jedes Mal alle Fallnummern auf Duplikate überprüft werden, und nur Zeilen neu importiert werden, die es noch nicht gibt, und alle anderen Zeilen (Personen), die nicht mehr auf der neuen Liste sind, dann aus der Excel Datei gelöscht werden.
Über eure Hilfe würde ich mich sehr freuen!
Vielen Dank im Voraus!
LG
Hier das Programm zum jetzigen Zeitpunkt (PS: Meistens befinden sich nicht mehr als 20 Personen auf der Liste, also lasse ich am Ende bei nlz = lz + 30 einfach mal 30 Zeilen unterhalb der letzten löschen, für eine elegantere Lösung bin ich natürlich auch sehr dankbar!):
Sub ImportCSV(Dateiname, ZielTabelle As String)
If Dateiname False Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Ws As Worksheet
Sheets.Add.Name = "CSV"
Set Ws = ActiveWorkbook.Sheets("CSV")
Workbooks.Open FileName:=Dateiname, Local:=True
ActiveSheet.UsedRange.Copy Ws.Cells(1)
ActiveWorkbook.Close SaveChanges:=False
Sheets("CSV").Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To FinalRow
ThisValue = Cells(x, 6).Value
If ThisValue Sheets("Aktuell").Cells(x, 6).Value Then
Range(Cells(x, 1), Cells(x, 10)).Copy
Sheets("Aktuell").Select
Range(Cells(x, 1), Cells(x, 10)).Select
ActiveSheet.Paste
Sheets("Aktuell").Range(Cells(x, 15), Cells(x, 20)).ClearContents
Sheets("CSV").Select
Else
End If
Next x
Dim lz As Integer
Dim nlz As Integer
lz = ActiveSheet.UsedRange.Rows.Count + 1
nlz = lz + 30
Sheets("Aktuell").Select
Range(Cells(lz, 1), Cells(nlz, 10)).Select
Selection.ClearContents
Range(Cells(lz, 15), Cells(nlz, 20)).Select
Selection.ClearContents
Sheets("CSV").Delete
Sheets("Aktuell").Range("K1").Select
Else
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub StartImportCSV()
Dim fileToOpen As String
ChDrive "H"
fileToOpen = Application.GetOpenFilename(FileFilter:="CSV Dateien (*.csv), *.csv", Title:="Exportierte .csv Datei öffnen")
ImportCSV fileToOpen, "CSV Import"
End Sub
