Экспорт текстового массива данных на лист Excel.

[GoreProgrammist]

Друзья, у меня проблема: есть текстовой файл (.txt), примерно 40мб, в нём содержатся данные об измерениях озона, представленные в виде чисел, одна строка - одно измерение:

"00119580102 1106216 3 53"

У меня стоит задача: скопировать построчно 4 числа на лист Excel, в первые 4е ячейки, но проблема в том что есть строки вида:

"00219940913091300267 3 11"

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

Пожалуйста подскажите как на VBA реализовать этот алгоритм записи в ячейки листа, с проверкой и по необходимости заменой 2ух символов?

Моих знаний в ВБА хватает на то как считать строку и записать её в ячейки на листе, проблема в том, что я считываю строку в myVar формата String, потом беру myVar1 из строки формата Long, получается 1 число из четырёх, оно записывается в ячейку и так до конца файла, всё хорошо, только Long отказывается работать с 00219940913091300267, и отрезает нули у первых чисел, то есть вместо 00119580102 записывает 119580102.

Sub ReadDataFromMailToDB()

Dim myVar As String
Dim myVar1 As Long
Dim i As Long
Dim rw As Long
Dim fileName As String
Dim fs
Dim a
Const vbShortDate = 2

'Открытие файла для ввода данных
Open "C:\Documents and Settings\Дуранчёст\Рабочий стол\РАБОТА\Программы\Обработка архива\O3TOT2.txt" For Input As #1
    
'Построчное считывание элементов текстового массива и создание из них списка переменных
'пока не достигнем конца файла
rw = 1
i = 1
Do While Not (EOF(1))
Input #1, myVar
fileName = "F:\Temp\Kirill\Saves\temp.txt"     'Создание файла Temp
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(fileName, True)
a.Write (myVar)                            'Запись строки текстового массива в файл Temp ввиде   переменой формата string
a.Close
Open "F:\Temp\Kirill\Saves\temp.txt" For Input As #2 'Открытие файла Temp для ввода данных
Do While Not (EOF(2))
                                            '
Input #2, myVar1
Cells(i + 1, rw).Value = myVar1
rw = rw + 1
Loop
i = i + 1
rw = 1                                      'Переход на следующую строчку с последующим
                                                  'закрытием и удалением файла Temp
Close 2
Kill ("F:\Temp\Kirill\Saves\temp.txt")
Loop
Close 1
End Sub

[GoreProgrammist]

Сам массив данных, и лист как я его организовал:

[doober]

Я не понял.зачем файлы переписывать.но на лист можно вывести так

Sub ReadDataFromMailToDB()
Dim myVar As String
Dim myVar1 As Long
Dim i As Long
Dim rw As Long
Dim fileName As String
Dim fs
Dim a
Const vbShortDate = 2
Open "F:\Temp\Kirill\Saves\Meteo Data.txt" For Input As #1
rw = 1
Do While Not (EOF(1))
Input #1, myVar

Cells(rw, 1).Value = Val(Mid(myVar, 1, 11))
Cells(rw, 2).Value = Val(Mid(myVar, 14, 7))
Cells(rw, 3).Value = Val(Mid(myVar, 24, 3))
Cells(rw, 4).Value = Val(Mid(myVar, 27, 4))
rw = rw + 1
Loop
Close 1
End Sub

Так сделать замену на 2 пробела

 
Input #1, myVar
 Mid(myVar, 12, 2) = " "

[GoreProgrammist]

Благодарю за такой простой и быстрый код) Мой быдлокодинг конечно ни в какое сравнение не идёт)

Есть ещё одно НО: формат Long обрезает нули в начале цифр, как этого избежать?

[doober]

Sub ReadDataFromMailToDB()
Dim myVar As String
Dim myVar1 As Long
Dim i As Long
Dim rw As Long
Dim fileName As String
Dim fs
Dim a
Const vbShortDate = 2
Open "F:\Temp\Kirill\Saves\Meteo Data.txt" For Input As #1
rw = 1
Do While Not (EOF(1))
Input #1, myVar

Cells(rw, 1).Value =   "'" & (Mid(myVar, 1, 11))
Cells(rw, 2).Value = (Mid(myVar, 14, 7))
Cells(rw, 3).Value = (Mid(myVar, 24, 3))
Cells(rw, 4).Value = (Mid(myVar, 27, 4))
rw = rw + 1
Loop
Close 1
End Sub

[Hugo121]

Действительно, зачем заменять два символа на пробелы, если они не нужны?
Я бы делал по примеру doober'а (брал из строки по Mid() ), только на fso и примерно так -
1. считал весь файл в переменную
2. разбил в массив по строкам
3. создал пустой массив нужной размерности (высота уже есть, ширина известна)
4. цикл по массиву, переложил нужные символы в нужные места
5. выгрузил на лист - или сперва задав текстовый формат нужным столбцам, или уже при заполнении массива добавил " ' " . С форматом больше нравится.

Хотя с другой строны - почему стандартный импорт не подходит?
Код - как записал рекордер, не чистил:

Option Explicit

Sub Макрос1()
'
' Макрос1 Макрос
'

'
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\массив измерений.txt", _
        Destination:=Range("$A$1"))
        .Name = "массив измерений"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 866
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 9, 2, 2, 2)
        .TextFileFixedColumnWidths = Array(11, 2, 8, 4)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub