Извлечь определенные строки файлов .tbl в excel

Похоже, вы ищете общие операции ввода-вывода, то есть чтение файла построчно. Был показан довольно хороший пример [здесь][1]

Чтобы достичь вашей цели, нам нужно добавить некоторые условия if для извлечения каждой третьей строки ваших текстовых файлов. Деление по модулю будет хорошим помощником. Например, у нас есть «i» в качестве номера строки тогда нам просто нужно, чтобы условие if выглядело примерно так:

If (i mod 3) = 0 Then ...

Это означает, что мы ищем каждое «i», которое делится на 3, дает нам остаток 0 Таким образом, наш код будет выглядеть примерно так

Sub ReadFileLineByLine()
Dim my_file As Integer
Dim text_line As String
Dim file_name As String
Dim i As Integer   

file_name = "C:\text_file.txt"   

my_file = FreeFile()
Open file_name For Input As my_file   

i = 1   

While Not EOF(my_file)
    Line Input #my_file, text_line
    If (i mod 3) = 0 Then
        Cells(i, "A").Value = text_line
    End If
    i = i + 1
Wend

Конец сабвуфера

[1]: https://excel.officetuts.net/vba/read-a-text-file/#:~:text=Reading%20a%20file%20line%20by%20line,-Let's%20read%20text&text=Open %20VBA%20Edit%20(Alt%20%2B%20F11 и %20вставьте%20%20следующий%20код.&text=First%2C%20a%20new%20file%20is, помещает%20it%20внутри%20a%20worksheet.

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

Вот такая функция (Отказ от ответственности: в этом коде нет управления ошибками, вероятно, его можно значительно улучшить)

Function Get3rdLine(filename As String)
    Dim f As Long
    f = FreeFile
    Open filename For Input As f
    Line Input #f, Get3rdLine ' just ignore this line
    Line Input #f, Get3rdLine ' and this one too
    Line Input #f, Get3rdLine ' and return this one
    Close #f
End Function

Вы можете вызвать его с путем к файлу, который вы хотите прочитать:

=Get3rdLine(CONCATENATE(A1,B1,C1)) например, если ваш путь определяется ячейками A1, B1 и C1.

Пожалуйста, попробуйте следующую функцию, если необходимые данные для извлечения существуют в одном файле, через каждые три строки. Она вернет 2D-массив, который можно сразу отбросить в нужном вам диапазоне:

Function extractThirdLine(filePath As String) As Variant
     Dim arrTxt, i As Long, arrFin, k As Long
     'read the file content in an array:
     arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(filePath, 1).ReadAll, vbCrLf)
     ReDim arrFin(1 To Int(UBound(arrTxt) / 3) + 1, 1 To 1)
     For i = 2 To UBound(arrTxt) Step 3 'start from 2, because  arrTxt is 1D array
        k = k + 1
        arrFin(k, 1) = arrTxt(i) 'build the filal array containing the necessary rows
     Next i
     extractThirdLine = arrFin
End Function

На вашем изображении не отображаются заголовки строк и столбцов. Итак, предположим, что диапазон, который вы нам показываете, существует в столбцах «A: C», и вам нужно поместить извлеченные данные в столбец «D: D», используйте следующий способ:

Sub testExtractThirdLine()
   Dim filePath As String, arrVal, el
   filePath = "your text file full name" 'please write here the correct file  name
   arrVal = extractThirdLine(filePath)
   Range("D1").Resize(UBound(arrVal), 1).value = arrVal
End Sub

Если диапазон, который вы показываете, не тот, который я предполагал, вы легко адаптируете Range("D1") к диапазону сразу после столбцов, и его строка будет первой строкой обсуждаемого диапазона.

Если что-то не достаточно ясно, пожалуйста, не стесняйтесь обращаться за разъяснениями.

Отредактировано:

Но если в файле можно найти каждую третью строку для каждой строки, а путь к соответствующему файлу получается конкатенацией трех столбцов, то следующую работу выполнит следующая функция:

Function extractLine(filePath As String) As String
   extractLine = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(filePath, 1).ReadAll, vbCrLf)(2)
End Function

Его можно назвать так:

Sub extractStrings()
 Dim i As Long, arr, arrFin, lastRow As Long
 
 lastRow = Range("A" & rows.count).End(xlUp).Row 'supposing that 'C:\' exists in A:A column
 arr = Range("A2:C" & lastRow).value
 ReDim arrFin(1 To UBound(arr), 1 To 1)
 
 For i = 1 To UBound(arr)
    arrFin(i, 1) = extractLine(arr(i, 1) & arr(i, 2) & arr(i, 3))
 Next i
 'drop the processed array content at once:
 Range("D2").Resize(UBound(arrFin), 1).value = arrFin
End Sub