Компиляция только одного столбца из текстового файла фиксированной ширины и включение имени файла Excel-VBA

Question

Полное раскрытие Я химик, и у меня ограниченный опыт работы с Excel VBA. У меня есть инструмент, который будет экспортировать только текстовые файлы фиксированной ширины. Мы генерируем тысячи таких файлов, и извлекать из них утомительно. Это просто два столбца данных в каждом файле. Я хотел бы иметь макрос, который скомпилирует все данные на одном листе, чтобы сделать работу быстрее. Мне нужен только столбец с числовыми данными, который будет столбцом B в файле, и я хотел бы, чтобы текстовое имя файла было выше этих данных. Это возможно? У меня есть макрос, который будет искать любую папку, которую вы указали, и скомпилирует данные, но он извлекает из обоих столбцов и не включает имя файла. Любые предложения о том, как изменить код? Я соединил это из сообщений, которые я нашел, прибегая к помощи, методом проб и ошибок. Любая помощь будет оценена!

Вот пример того, как данные выглядят в текстовом файле.
Text01

Sub ImportTXTFiles()
    Dim importrow As Long
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    With ActiveSheet'''

        For Each txtfile In txtfilesToOpen

            importrow = .Cells(.Rows.Count, 5).End(xlUp).Row

            With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=.Cells(importrow, 1))
                .TextFileParseType = xlFixedWidth
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1)
                .TextFileFixedColumnWidths = Array(32)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With


        Next txtfile

        For Each qt In .QueryTables
            qt.Delete
        Next qt

    End With

    MsgBox "Done !", vbInformation, "SUCCESS !"

    Set fso = Nothing
End Sub

Answer 1

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

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim txtfilesToOpen As Variant
    Dim txtfile As Variant
    Dim intFile As Integer
    Dim strInput As String
    Dim lngRow As Long
    Dim lngCol As Long
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")
    With ActiveSheet '''
        lngCol = 2
        For Each txtfile In txtfilesToOpen
            lngRow = 1
            .Cells(lngRow, lngCol) = Dir(txtfile)
            lngRow = lngRow + 1
            intFile = FreeFile
            Open txtfile For Input As intFile
            Do
                Line Input #intFile, strInput
                .Cells(lngRow, lngCol) = Mid(strInput, 30)
                lngRow = lngRow + 1
            Loop Until EOF(intFile)
            Close #intFile
            lngCol = lngCol + 1
        Next txtfile
    End With
    MsgBox "Done !", vbInformation, "SUCCESS !"
    Set fso = Nothing
End Sub

С уважением,