Wie werden Daten automatisch aus einer CSV-Datei importiert und an eine vorhandene Excel-Tabelle angehängt

3876
cmccarra

Ich habe eine CSV-Datei und eine Master-Excel-Datei. Die Master-Datei enthält eine Tabelle, und ich möchte die Daten in der CSV-Datei automatisch an die vorhandene Tabelle anhängen. Die Daten haben die gleiche Kopfzeile und Spaltenreihenfolge. Ich habe die folgende VBA, die die CSV-Daten an die nächste Zeile nach der Tabelle anhängt, aber die Daten sind nicht Teil der Tabelle:

Sub Append_CSV_File()  Dim csvFileName As Variant Dim destCell As Range  Set destCell = Worksheets("Sheet1").Cells(Rows.Count,  "E").End(xlUp).Offset(1) 'Sheet1  csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files  (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False) If csvFileName = False Then Exit Sub  With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & csvFileName,  Destination:=destCell) .TextFileStartRow = 2 .TextFileParseType = xlDelimited .TextFileCommaDelimiter = True .Refresh BackgroundQuery:=False End With  destCell.Parent.QueryTables(1).Delete  End Sub

Es gibt auch Spalten in der Tabelle rechts von den Daten, die einen Wert aus den importierten Daten berechnen. Gibt es überhaupt eine Möglichkeit, die Formeln automatisch in die Spalte zu kopieren, wenn die neuen Daten angehängt werden?

0

1 Antwort auf die Frage

0
Russ

Ich hatte das gleiche Problem und wollte mehrere (16, um genau zu sein) CSV-Dateien in einer Auflistung anhängen. Das von mir verwendete Array ist statisch und es gibt bessere Möglichkeiten, dies zu codieren. Ich musste jedoch bestimmte Dateien aus einer Reihe von CSV-Dateien sammeln, die sich innerhalb des Ordners befinden.

Ich fand Ihren Code interessant und aktualisierte den Code, den ich aus anderen Quellen zusammengestellt hatte, damit ein Satz Code funktioniert.

Vielen Dank, dass Sie Ihren Code freigegeben haben. Wie Sie sehen werden, habe ich ein Element Ihres Codes verwendet, um die nächste leere Zeile zu finden, an die angehängt werden soll.

Siehe Codebeispiel unten. Sie müssen die Dateinamen und den Dateiverzeichnispfad hinzufügen und das xFiles-Array so aktualisieren, dass es der Anzahl der Dateien entspricht, die Sie importieren und anhängen möchten:

Sub LoadDelimitedFiles()  Dim xStrPath As String Dim xFile As String Dim xCount As Long Dim xFiles(15) As String Dim destCell As Range  On Error GoTo ErrHandler 'added an update to the code to select the individual file names needed from server within a folder  'PathName of Folder Location xStrPath = "<Insert Folder Location>"  'Name the Array with the CSV files name for file Content  xFiles(0) = "<Filename1>" xFiles(1) = "<Filename2>" xFiles(2) = "<Filename3>" xFiles(3) = "<Filename4>" xFiles(4) = "<Filename5>" xFiles(5) = "<Filename6>" xFiles(6) = "<Filename7>" xFiles(7) = "<Filename8>" xFiles(8) = "<Filename9>" xFiles(9) = "<Filename10>" xFiles(10) = "<Filename11>" xFiles(11) = "<Filename12>" xFiles(12) = "<Filename13>" xFiles(13) = "<Filename14>" xFiles(14) = "<Filename15>" xFiles(15) = "<Filename16>"  xCount = 0  If xStrPath = "" Then Exit Sub Application.ScreenUpdating = False  'Clear Existing Sheet Data Columns("A:I").Select Selection.Delete Shift:=xlToLeft Range("A1").Select  'Set the 1st Filename xFile = Dir(xStrPath & xFiles(xCount) & ".csv")  'destCell contains the location of the next cell to append the next csv file data to Set destCell = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)  Do While xCount <> 16 xFile = Dir(xStrPath & xFiles(xCount) & ".csv") With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _ & xStrPath & xFile, Destination:=destCell) .Name = "a" & xCount .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileOtherDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False  Set destCell = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1) xCount = xCount + 1 End With  Loop 'Remove the Blank Top row Rows("1:1").Select Selection.Delete Shift:=xlUp Range("A1").Select  'Update the screen to show the contents appended csv file data Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox "no files found",, "Error Message" End Sub

Verwandte Probleme