Импорт нескольких CSV на несколько листов в одной книге

Ответ 1

Этот парень полностью прибил его. Очень сжатый код и отлично работает для меня в 2010 году. Весь кредит ему принадлежит (Jerry Beaucaire). Я нашел это из форума здесь.

Option Explicit
Sub ImportCSVs()
'Author:    Jerry Beaucaire
'Date:      8/16/2010
'Summary:   Import all CSV files from a folder into separate sheets
'           named for the CSV filenames

'Update:    2/8/2013   Macro replaces existing sheets if they already exist in master workbook

Dim fPath   As String
Dim fCSV    As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook

Set wbMST = ThisWorkbook
fPath = "C:\test\"                  'path to CSV files, include the final \
Application.ScreenUpdating = False  'speed up macro
Application.DisplayAlerts = False   'no error messages, take default answers
fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    On Error Resume Next
    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)                    'open a CSV file
        wbMST.Sheets(ActiveSheet.Name).Delete                       'delete sheet if it exists
        ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)    'move new sheet into Mstr
        Columns.Autofit             'clean up display 
        fCSV = Dir                  'ready next CSV
    Loop

Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub

Ответ 2

Остерегайтесь, это не обрабатывает ошибки, как если бы вы имели имя дублированного листа, если вы импортировали csv.

Это использует раннее связывание, поэтому вам нужно обратиться к Microsoft.Scripting.Runtime в разделе "Инструменты". Ссылки в VBE

Dim fs  As New FileSystemObject
Dim fo As Folder
Dim fi As File
Dim wb As Workbook
Dim ws As Worksheet
Dim sname As String

Sub loadall()
    Set wb = ThisWorkbook

    Set fo = fs.GetFolder("C:\TEMP\")

    For Each fi In fo.Files
        If UCase(Right(fi.name, 4)) = ".CSV" Then
            sname = Replace(Replace(fi.name, ":", "_"), "\", "-")

            Set ws = wb.Sheets.Add
            ws.name = sname
            Call yourRecordedLoaderModified(fi.Path, ws)
        End If
    Next
End Sub

Sub yourRecordedLoaderModified(what As String, where As Worksheet)
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & what, Destination:=Range("$A$1"))
    .name = "test1"
    .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
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
End Sub

Ответ 3

Вы можете использовать Dir для фильтрации и запуска с помощью только файлов csv

Sub MacroLoop()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("c:\test\*.csv")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & "C:\test\" & strFile, Destination:=Range("$A$1"))
    .Name = strFile
    .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
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub

Ответ 4

Я не пробовал это, но я бы пошел с this:

Dim NumFound As Long 
With Application.FileSearch 
    .NewSearch
    .LookIn = "C:\test\"
    .FileName = "*.csv"
    If .Execute() > 0 Then 
        For i = 1 To .FoundFiles.Count
            With ActiveSheet.QueryTables.Add(Connection:= _
                "TEXT;" & "C:\test\" & (Application.FileSearch.FoundFiles(i)), Destination:=Range("$A$1"))
                ...
            End With
            Sheets.Add After:=Sheets(Sheets.Count)
        Next i
    End If
End With

Ответ 5

У меня было 183 CSV файла, которые можно было объединить в одну рабочую книгу, по одному рабочему листу на CSV файл для облегчения анализа данных, и я не хотел делать это вручную за один раз. Я попробовал решение этого вопроса с самым высоким рейтингом, но у меня была та же проблема, что и у другого пользователя; CSV файлы будут открыты, но ничего не будет вставлено в целевую книгу. Я потратил некоторое время и скорректировал код так, чтобы он работал так же, как в Excel 2016. Я не тестировал старые версии. Я давно не программировал в Visual Basic, так что, вероятно, в моем коде есть масса возможностей для улучшения, но это помогло мне в крайнем случае. На случай, если кто-нибудь натолкнется на этот вопрос, как я, я вставлю код, который использовал ниже.

Option Explicit
Sub ImportCSVs()
'Author:    Jerry Beaucaire
'Date:      8/16/2010
'Summary:   Import all CSV files from a folder into separate sheets
'           named for the CSV filenames

'Update:    2/8/2013   Macro replaces existing sheets if they already exist in master workbook
'Update: base script as seen in: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/merge-functions/csvs-to-sheets
'Update: adjusted code to work in Excel 2016

Dim fPath   As String
Dim fCSV    As String
Dim wbName  As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook


wbName = "this is a string"
Set wbMST = ThisWorkbook

fPath = "C:\pathOfCSVFiles\"                  'path to CSV files, include the final \
Application.ScreenUpdating = False  'speed up macro
Application.DisplayAlerts = False   'no error messages, take default answers
fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    On Error Resume Next
    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)                    'open a CSV file
        If wbName = "this is a string" Then 'this is to check if we are just starting out and target workbook only has default Sheet 1
            wbCSV.Sheets.Copy After:=wbMST.Sheets(1) 'for first pass, can leave as is. if loading a large number of csv files and excel crashes midway, update this to the last csv that was loaded to the target workbook
        Else
            wbCSV.Sheets.Copy After:=wbMST.Sheets(wbName) 'if not first pass, then insert csv after last one
        End If

        fCSV = Dir                  'ready next CSV
        wbName = ActiveSheet.Name 'save name of csv loaded in this pass, to be used in the next pass
    Loop

Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub