Цикл для считывания таблицы с переменным количеством строк

[Nicolas_46]

Уважаемые форумчане, помогите справиться с такой проблемой.
Необходимо считать информацию из файла и распредилить ее по ячейкам,
но вот в чем загвоздка:
в файле существует таблица с переменным числом строк (то есть в одном случае их 10 в другом
5 в третьем может вобще таблицы не быть) Из-за этого когда построчно считывается файл ииформация распредиляется не в те ячейки, как можно решить эту проблему?
примеры различных вариантов файла приведены ниже.

без таблицы считываю файл таким образом

Sub Блок_№5_Блок_№6()

Dim strFileName As String
Dim strFileTitle As String
strFileTitle = "REZ05.re"
strFileName = ThisWorkbook.Path & "\REZ05.re"
If Dir(strFileName) <> "" Then
      
   Else: GoTo exxx
   End If

Dim TextLine
'1
i = 1
Open ThisWorkbook.Path & "\REZ05.re" For Input As #1

Do While Not EOF(1)
Line Input #1, TextLine

If i = 7 Then
    Range("E5").Select
    ActiveCell.FormulaR1C1 = Mid(TextLine, 50, 7)
End If

If i = 7 Then
    Range("E5").Select
    ActiveCell.FormulaR1C1 = Mid(TextLine, 50, 7)
End If


i = i + 1
Loop
Close #1
Exit Sub
exxx:
MsgBox "файл результата не найден"
End Sub

[doober]

Признак наличия таблицы -
это строка символов ******.
они же определяют начало и окончание таблицы.

[Nicolas_46]

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

[doober]

На основе макроса Hugo121

Фрагмент кода,как идея

Dim Trigger As Boolean
Trigger = False
Set outFileNew = fso.CreateTextFile("c:\Temp\Nicolas_46\Newrez.re")

For i = 0 To UBound(arrstr)
    If Len(Trim(arrstr(i))) > 0 Then
        If InStr(1, arrstr(i), "****", vbTextCompare) > 0 And Trigger = False Then
            Trigger = True
            GoTo ContinueFor
        ElseIf InStr(1, arrstr(i), "****", vbTextCompare) > 0 And Trigger = True Then
            Trigger = False
            GoTo ContinueFor
        End If
        If Trigger = True Then
            outFileNew.WriteLine arrstr(i)
        Else
            outFile.WriteLine arrstr(i)
        End If
    End If
ContinueFor:
Next

[alex77755]

Вроде отправлял свой вариант, а что-то нету..

 Sub QWERT()
Dim M() As String
Dim R, S() As String, C, Lr
   Dim File As String, CF As String   'объявим пеpеменнyю для имени файла и его cодеpжимого
   File = ThisWorkbook.Path & "\REZ05.re"    'ycтановим имя файла и пyть
   Open File For Binary As #1   'откpоем файл для чтения
      CF = Input(FileLen(File), 1)   'загpyзить в пеpеменyю CF вcе cодеpжимое файла
   Close #1   'закpыть файл
   M = Split(Trim(CF), vbNewLine)
   For R = 0 To UBound(M)
   If InStr(1, M(R), "---I--") > 0 Then ' начало таблицы без шапки. Если нужна с шапкой искать "********"
   Exit For
   End If
   Next R

Do '
R = R + 1
If InStr(1, M(R), "I") > 0 Then '
  S = Split(M(R), "I")
    lr = Cells(Rows.Count, 3).End(xlUp).Row + 1 '
    For C = 1 To UBound(S) - 1 '
        Cells(lr, C + 1) = Replace(Trim(S(C)), ".", ",")
    Next C

End If
Loop While InStr(1, M(R + 1), "*******") = 0 '
   
End Sub

[Nicolas_46]

файл отчет,