Цикл VBA, чтобы открыть несколько текстовых файлов в одной папке на одном листе Excel - PullRequest
0 голосов
/ 13 октября 2019

У меня проблемы с циклом vba для импорта 21 имеющегося у меня текстового файла в один лист Excel. Я нашел это здесь, но продолжаю получать код ошибки. Я хочу, чтобы vba перебрал одну папку, скопировал и вставил в основной файл один столбец вместе с файлом над набором данных.

Sub combine()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Dim ExcelApp As Object
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = False
    ExcelApp.ScreenUpdating = False
    ExcelApp.DisplayAlerts = False
    ExcelApp.EnableEvents = False

    '**VARIABLES**
    Dim folderPath As String
    folderPath = "Y:\plan_graphs\final\mich_alco_test\files\"

    'COUNT THE FILES
    Dim totalFiles As Long
    totalFiles = 0
    Dim fileTitle As String
    fileTitle = Dir(folderPath & "*.xl??")
    Do While fileTitle <> ""
    totalFiles = totalFiles + 1
    fileTitle = Dir()
    Loop

    'OPENING FILES
    Dim resultWorkbook As Workbook
    Dim dataWorkbook As Workbook
    Set resultWorkbook = ExcelApp.Application.Workbooks.Open("Y:\plan_graphs\final\mich_alco_test\result.xlsx")


    fileTitle = Dir(folderPath & "*.xl??")

    'FOR EACH FILE
    Do While fileTitle <> ""
        Set dataWorkbook = ExcelApp.Application.Workbooks.Open(folderPath & fileTitle)
        dataWorkbook.Worksheets("List1").Range("A1").Select
        dataWorkbook.Worksheets("List1").Selection.CurrentRegion.Select


         `resultWorkbook.Range
         fileTitle = Dir()
     Loop

    ExcelApp.Quit
    Set ExcelApp = Nothing
End Sub

Спасибовы.

1 Ответ

0 голосов
/ 13 октября 2019

Не проверено:

Sub combine()

    Const FOLDER_PATH As String = "Y:\plan_graphs\final\mich_alco_test\"

    Dim resultWorkbook As Workbook, fileTitle, i as long
    Dim dataWorkbook As Workbook
    Set resultWorkbook = Workbooks.Open(FOLDER_PATH & "result.xlsx")

    i = 0 
    fileTitle = Dir(FOLDER_PATH & "files\*.xl??")

    Do While fileTitle <> ""
        i = i + 1 
        With Workbooks.Open(folderPath & "files\" & fileTitle)
            .Worksheets("List1").Range("A1").CurrentRegion.Copy _
               resultWorkbook.Sheets("data").Cells(2,i)
            .Close False 'don't save
        End With
        resultWorkbook.Sheets("data").Cells(1, i).Value = fileTitle 
        fileTitle = Dir()
    Loop

End Sub

Если вы уже в Excel, для этого не нужно создавать новый экземпляр.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...