Если у вас есть этот файл организован визуально, я бы пошел по этой логике.Это означает, что значение столбца начинается там, где начинается заголовок столбца.Это означает, что значение столбца заканчивается там, где начинается следующий.
Полезное изображение, описывающее логику (также, пример текстового файла, который я использовал):
![enter image description here](https://i.stack.imgur.com/UDZ87.png)
Вся эта логика может быть выполнена путем чтения первой строки, содержащей заголовки, и определения всех индексов начала каждого заголовка.Затем для каждой строки мы можем легко определить значение между двумя конкретными индексами, вырезать его и обрезать, чтобы удалить лишние пробелы в начале и в конце значения.
Попробуйте код ниже (все необходимые комментарии в коде):
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