Как автоматически импортировать данные из CSV-файла и добавить в существующую таблицу Excel

Question

У меня есть файл .csv и мастер-файл Excel. Главный файл содержит таблицу, и я хотел бы автоматически добавить данные из CSV-файла в существующую таблицу. Данные имеют одинаковые заголовки и порядок столбцов. У меня есть следующий VBA, который добавляет данные .csv к следующей строке после таблицы штрафа, но данные не являются частью таблицы:

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

Справа от данных есть столбцы в таблице, которые рассчитывают значение из импортированных данных. Есть ли способ автоматически скопировать формулы в столбец при добавлении новых данных?

Answer 1

У меня была та же проблема, и я хотел добавить несколько (16, если быть точным) CSV-файлов в один листинг. Массив, который я использовал, является статическим, и есть лучшие способы его кодирования, но мне нужно было собрать определенные файлы из нескольких CSV-файлов, которые находятся в папке.

Я нашел ваш код интересным и обновил код, который я собрал из других источников, чтобы заставить работать код.

Спасибо, что поделились своим кодом, как вы увидите, я использовал элемент вашего кода, чтобы найти следующую пустую строку для добавления.

Ниже приведен пример кода, вам необходимо добавить имена файлов и путь к каталогу файлов, а также обновить массив xFiles, чтобы он соответствовал количеству файлов, которые вы хотите импортировать и добавить:

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