Сохранение «столбцов» при записи из текстового файла для превосходства с использованием VBA - PullRequest
0 голосов
/ 17 октября 2018

У меня есть текстовый файл, который отформатирован следующим образом:

enter image description here

И я использую приведенный ниже код в VBA для написания текстафайл в Excel:

Sub Test()

 Dim Fn As String, WS As Worksheet, st As String

 Fn = "Path.txt" ' the file path and name
 Set WS = Sheets("Sheet1")

 'Read text file to st string
 With CreateObject("Scripting.FileSystemObject")
    If Not .FileExists(Fn) Then
        MsgBox Fn & "  : is missing."
        Exit Sub
    Else
        If FileLen(Fn) = 0 Then
            MsgBox Fn & "  : is empty"
            Exit Sub
        Else
            With .OpenTextFile(Fn, 1)
             st = .ReadAll
             .Close
            End With
        End If
    End If
 End With

 'Replace every two or more space in st string with vbTab
 With CreateObject("VBScript.RegExp")
  .Pattern = "[ ]{2,}"
  .Global = True
  .Execute st
  st = .Replace(st, vbTab)
 End With

 'Put st string in Clipboard
 With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText st
    .PutInClipboard
 End With

 'Paste Clipboard to range
 WS.Range("A1").PasteSpecial

End Sub

Моя цель - сохранить столбцы из текстового файла в Excel.

Однако, мой код не может сказать, что пробел под Plan Type ипробел под Benefit Plan - это фактически два разных столбца данных.Он обрабатывает пустое пространство под двумя столбцами как одно длинное пустое пространство, и форматирование не сохраняется.

Визуально мы знаем, что есть столбцы, но мой код не видит этого.

Есть ли способ запрограммировать это, чтобы он распознавал, что в текстовом файле вместо одного большого пробела есть два пробела?

Чего я хочу избежать, так это того, чтобы вручную определять это с помощью символа.Это возможно?

Ответы [ 5 ]

0 голосов
/ 24 октября 2018

вы можете:

  • обработать строку со всеми "-", чтобы получить фактическую ширину полей

  • вставить все текстовое содержимоев столбец разыскиваемого листа A строки

  • использовать метод TextToColumns() для разбивки текста из столбца A на столько столбцов, сколько необходимо, что определяется правильной обработкой строки "-"

следующим образом:

Option Explicit

Sub Test()

    Dim Fn As String, WS As Worksheet
    Dim lines As Variant, line As Variant

    Fn = "Path.txt" ' the file path and name
    Set WS = Sheets("Sheet1")

    'Read text file to st string
    With CreateObject("Scripting.FileSystemObject")
       If Not .FileExists(Fn) Then
           MsgBox Fn & "  : is missing."
           Exit Sub
       Else
           If FileLen(Fn) = 0 Then
               MsgBox Fn & "  : is empty"
               Exit Sub
           Else
                With .OpenTextFile(Fn, 1)
                    lines = Split(.readall, vbLf)
                    .Close
                End With
           End If
       End If
    End With

    For Each line In lines ' loop through all text lines
        If InStr(line, "-") > 0 Then Exit For ' loop till you reach the "-"s line, which will be used to get FieldInfo array for textToColumns method
    Next

    With WS
        .Range("a1").Resize(UBound(lines) + 1).Value = Application.Transpose(lines) ' copy all text lines into column A rows
        .Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, FieldInfo:=GetFieldInfo(Trim(line)), TrailingMinusNumbers:=True ' convert text to columns feeding FieldInfo array arranged from the "-"s line structure
    End With

End Sub


Function GetFieldInfo(st As String) As Variant()
    Dim i As Long, n As Long, nFields As Long

    nFields = UBound(Split(WorksheetFunction.Trim(st), " ")) ' get the number of fields by counting the "-"s groups separated by single space

    ReDim arrtext(0 To nFields) ' size FieldInfo array accordingly
    Do
        arrtext(i) = Array(n, 1) ' build current FieldInfo array field with current field position in text
        n = InStr(n + 1, st, " -") ' search next field position
        i = i + 1
    Loop While i < nFields
    arrtext(i) = Array(n, 1) ' build last FieldInfo array field with last field position in text

    GetFieldInfo = arrtext ' return FieldInfo array
End Function
0 голосов
/ 23 октября 2018

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

Полезное изображение, описывающее логику (также, пример текстового файла, который я использовал):

enter image description here

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

Попробуйте код ниже (все необходимые комментарии в коде):

Sub ReadDataFromCsv()
    Dim Fn As String, WS As Worksheet, st As String, i As Long, columnHeadersIndexes As Object, numberOfColumns As Long
    Fn = "your path here" ' the file path and name
    Set WS = Sheets("Sheet1")
    ' Create array that will hold indexes of a beginning of a column header
    Set columnHeadersIndexes = CreateObject("System.Collections.ArrayList")
    'Read text file to st string
    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(Fn) Then
            MsgBox Fn & "  : is missing."
            Exit Sub
        ElseIf FileLen(Fn) = 0 Then
            MsgBox Fn & "  : is empty"
        Else
            With .OpenTextFile(Fn, 1)
                ' Read first line
                st = .ReadLine
                i = 1
                ' Find beginning of first column name
                Do While Mid(st, i, 1) = " "
                    i = i + 1
                Loop
                columnHeadersIndexes.Add (i)
                ' At least two spaces separate two headers, so we can safely add 2 without risk of loosing any letters frmo next header
                i = i + 2
                Dim j As Long: j = 1
                Do While i < Len(st)
                    ' If we have two spaces followed by non-space, then save index (beginning of a header)
                    If Mid(st, i - 2, 2) = "  " And Mid(st, i, 1) <> " " Then
                        ' Set column header
                        Cells(1, j) = Mid(st, columnHeadersIndexes(columnHeadersIndexes.Count - 1), i - columnHeadersIndexes(columnHeadersIndexes.Count - 1) - 1)
                        columnHeadersIndexes.Add (i)
                        j = j + 1
                    End If
                    i = i + 1
                Loop
                ' Set column header
                Cells(1, j) = Trim(Mid(st, columnHeadersIndexes(columnHeadersIndexes.Count - 1), Len(st)))
                numberOfColumns = columnHeadersIndexes.Count
                ' Skip line with ------ characters
                .ReadLine
                Dim currentRow As Long: currentRow = 2
                Do While .AtEndOfStream <> True
                    st = .ReadLine
                    ' Read all columns from a line
                    For i = 0 To numberOfColumns - 2
                        If Len(st) >= columnHeadersIndexes(i) Then
                            cellValue = Mid(st, columnHeadersIndexes(i), columnHeadersIndexes(i + 1) - columnHeadersIndexes(i) - 1)
                            cellValue = Trim(cellValue)
                            Cells(currentRow, i + 1) = cellValue
                        End If
                    Next
                    ' Read last column, if exists
                    If Len(st) >= columnHeadersIndexes(i) Then
                        'here we pass Len(st) as length for substring - it assures that we don't pass too small value and miss some characters
                        cellValue = Mid(st, columnHeadersIndexes(i), Len(st))
                        cellValue = Trim(cellValue)
                        Cells(currentRow, i + 1) = cellValue
                    End If
                    currentRow = currentRow + 1
                Loop
                .Close
            End With
        End If
    End With
End Sub
0 голосов
/ 22 октября 2018

Если предположить, что длина каждого столбца составляет 10 символов, я бы использовал эту ширину вместо разделителя пробелов

Sub FeedTextFileToActiveSheet(ByVal TextFile As String)
  Dim i As Integer, Line As String
  Open TextFile For Input As #1
  While Not EOF(#1)
    i = i + 1
    Input #1, Line
    Range("A" & i) = Trim(Mid(Line, 1, 10))  'Business ID
    Range("B" & i) = Trim(Mid(Line, 11, 10)) 'Employee ID
    ' ... and so on
  Wend
  Close #1
End Sub

Чтобы использовать его, просто вызовите FeedTextFileToActiveSheet("Path.txt")

0 голосов
/ 23 октября 2018

Если файл выглядит точно так же, как изображение при открытии в блокноте, скорее всего, это фиксированная ширина .Как бы то ни было, лучше перейдите в пустую книгу, запустите макрос записи и попробуйте открыть текстовый файл.Автоматически откроется Мастер импорта текста.Выберите тип «Фиксированная ширина» (предпочтительно) или с разделителями, проходите каждый этап, внимательно читая предоставленную инструкцию.(Когда запрашивается начальный импорт в строке, лучше указать первую строку, содержащую важные данные, пропуская строки заголовка и т. Д.).Когда файл полностью открыт, остановите запись.У вас будет записанный макрос примерно такого типа.

Workbooks.OpenText Filename:="C:\Users\user\Desktop\Text.prn", Origin:= _
        xlMSDOS, StartRow:=5, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1) _
        , Array(14, 1), Array(29, 1), Array(44, 1), Array(59, 1), Array(74, 5), Array(89, 1), Array( _
        104, 1)), TrailingMinusNumbers:=True

Теперь просто используйте эту часть кода (возможно, с небольшими изменениями в имени файла и т. Д.) В вашей процедуре, чтобы открыть текстовый файл.Затем просто скопируйте текущий регион и вставьте в рабочий лист, уже подготовленный с заголовками и т. Д., Например.

ActiveWorkbook.ActiveSheet.Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets(1).Range("a5")
 ActiveWorkbook.Close False
0 голосов
/ 22 октября 2018

Вы пробовали "вариант импорта из текстового файла" в Excel?Если вы просто хотите импортировать текстовый файл в Excel с заголовками или без них, вы можете импортировать напрямую в Excel, используя встроенную опцию, доступную в Excel . Это правильно распознает заголовок и пробелы.Следует отметить, что заголовки текстового файла всегда должны быть в первой строке для этого метода.Если вы не уверены в этом, то можете воспользоваться vba script.if так, тогда вам поможет ссылка, предоставленная ferdinando.

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