Макрос на загрузку текстового файла в таблицу Excel

Sub Main()
    Dim TextLine As String
    Dim myRow
    Dim myCount
    Open "Z:\Filename.txt" For Input As #1
    Лист1.Range("A17:L8000") = Clear
    myRow = Лист1.Cells.End(xlDown).Row
      Do While Not EOF(1)
    myRow = myRow + 1
    myCount = 1
    Line Input #1, TextLine
    While TextLine <> "***" And Not EOF(1)
    Лист1.Cells(myRow, myCount) = TextLine
    myCount = myCount + 1
    Line Input #1, TextLine
    Wend
    Loop
    Close #1
End Sub

Sub LoadTXT()
    Dim sFiles As String, s As String, r As Double
    Cells.Clear
    sFiles = "Z:\Filename.txt"
    Open sFiles For Input As #1
    Do While Not EOF(1)
        Line Input #1, s
        If s = "***" Then Exit Do
        r = r + 1
        Cells(r, 1) = s
    Loop
    Close #1
 
End Sub

   Dim File As String, CF As String    'объявим пеpеменнyю для имени файла и его cодеpжимого 
   File = "d:\ca.log"    '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(CF,"***")

Sub Main29()
    Dim TextLine As String
    Dim myRow
    Dim myCount
    
    Excel.ActiveWorkbook.Worksheets("лист1").Activate
    Open "c:\rab\Filename.txt" For Input As #1
    ActiveSheet.Range("A17:L8000").Clear
    ''myRow = ActiveSheet.Cells.End(xlDown).Row
    myRow = 16
    Do While EOF(1) = False
    myRow = myRow + 1
    myCount = 0
    
    Do While EOF(1) = False
    Line Input #1, TextLine
    TextLine = Trim(TextLine)
    If TextLine = "***" Then
    Exit Do
    End If
    myCount = myCount + 1
    ActiveSheet.Cells(myRow, myCount) = TextLine
    Loop
    Loop
    Close #1
End Sub

Visual Basic
Выделить код
Sub LoadTXT()
    Dim sFiles As String, s As String, r As Double
    Cells.Clear
    sFiles = "Z:\Filename.txt"
    Open sFiles For Input As #1
    Do While Not EOF(1)
        Line Input #1, s
        If s = "***" Then Exit Do
        r = r + 1
        Cells(r, 1) = s
    Loop
    Close #1
 
End Sub

Sub LoadTXT()
    Dim sFiles As String, s As String, r As Double
    Cells.Clear
    sFiles = "Z:\Filename.txt"
    Open sFiles For Input As #1
    Do While Not EOF(1)
        Line Input #1, s
        If InStr(1, s, ";") > 0 Then
        
        '        если ключ раздела по столбцам считались как одну. Но это не правильно!!.
                Do While InStr(1, s, ";;") > 0 '
                    s = Replace(s, ";;", ";") '
                Loop
                
                t = Split(s, ";")
                r = r + 1
                For i = 0 To UBound(t)
                        Cells(r, i + 1) = t(i)
                 Next i
         
        End If
    Loop
    Close #1
End Sub