VBA для Excel; редактирование очень больших файлов

jefti спросил: 28 апреля 2018 в 09:02 в: excel-vba

У меня очень большой набор файлов журналов с данными AIS (отправка). Поскольку эти файлы журналов составляют около 200 МБ в день, я пытаюсь их отсортировать для архивирования. Файлы выглядят следующим образом:

244630075;under way ;128°'; 0.0kt;52.395290N;4.886883E;342.0°;511°;55s; 170418 000000;serial#1(A)[1]
244670835;under way ;128°'; 0.0kt;52.410140N;4.833700E;283.8°;511°;54s; 170418 000000;serial#1(B)[3]
244750830;under way ;128°'; 0.0kt;52.404563N;4.864063E;  0.0°;511°;55s; 170418 000000;serial#1(B)[1]
244900124;under way ;000°'; 7.1kt;52.426495N;4.780100E;279.4°;281°;56s; 170418 000000;serial#1(B)[2]
244670779;under way ;000°'; 0.0kt;52.420773N;4.801418E;330.9°;325°;58s; 170418 000000;serial#1(A)[1]
244660512;under way ;128°'; 0.0kt;52.402092N;4.781258E;268.3°;511°;54s; 170418 000000;serial#1(B)[1]
236202000;under way ;000°';11.7kt;52.477408N;4.462048E;285.4°;296°;55s; 170418 000000;serial#1(B)[1]
244690403;under way ;128°'; 0.0kt;52.400760N;4.891647E;  0.0°;511°;55s; 170418 000000;serial#1(A)[1]

Это продолжается примерно для 2 миллионов строк на файл. Чтобы уменьшить размер этих файлов, я хочу удалить каждую строку, содержащую "0.0kt", поскольку это представляет собой информацию, которая мне не подходит. Для этого я написал сценарий VBA в Excel. У меня, похоже, сценарий работает в основном. Он проходит через файл и редактирует все строки, содержащие "0.0kt". Но когда сценарий заканчивается и он должен сохранить его, он экспортирует пустой файл.

Это мой скрипт:

Sub test()
'this will force the script to end when end of file is reached
On Error GoTo ASDConst ForReading = 1
Const ForWriting = 2Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\x\170418.log", ForReading)x = 1Do
Do While i < 1000        strline = objFile.ReadLine
         If InStr(strline, " 0.0kt") = 28 Then
            strline = "" & vbCrLf        End If
    i = i + 1Loop'doevents and a calculation to call doevents after 1000 lines to prevent freezing of the script
DoEvents
a = a + 1
b = a * 1000
i = i + b
x = i / 1000
i = 0
iLineNumber = xLoopASD:objFile.CloseSet objFile = objFSO.OpenTextFile("C:\x\170418.log", ForWriting)
objFile.Write strlineobjFile.CloseEnd Sub

Что мне не хватает, чтобы сохранить и закрыть файл со всеми строками, содержащими "0.0kt", удалены, а не все удаленные строки?

Спасибо


2 ответа

Есть решение
CLR ответил: 28 апреля 2018 в 11:47

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

Используя что-то, что я уже создал, я изменил его, чтобы забрать ваш файл и используйте DoEvents каждые 1000 строк.

Sub Test()    Dim ifileno As Integer, ofileno As Integer, rownum As Long
    Dim ifilename As String, ofilename As String, excludestring As String, strLine As String    ifilename = "C:\Users\v.doynov\Desktop\nd.txt"
    ofilename = "C:\Users\v.doynov\Desktop\nd_output.txt"
    excludestring = "; 0.0kt;"    ifileno = FreeFile
    Open ifilename For Input As ifileno    ofileno = FreeFile
    Open ofilename For Output As ofileno    rownum = 0    Do Until EOF(ifileno)
        rownum = rownum + 1
        Line Input #ifileno, strLine
        If InStr(strLine, excludestring) = 0 Then Print #ofileno, strLine
        If rownum Mod 1000 = 0 Then DoEvents
    Loop    Close ifileno
    Close ofilenoEnd Sub
Vityata ответил: 28 апреля 2018 в 09:15

С использованием вашего кода я подошел к чему-то вроде этого:

Sub TestMe()    On Error GoTo ASD
    Dim objFSO As Object
    Dim objFile As Object
    Dim x&, i&, strLine$, a&, b&, iLineNumber&
    Const ForReading = 1
    Const ForWriting = 2    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile("C:\Users\v.doynov\Desktop\nd.txt")    x = 1
    Dim newString As String
    Do
        Do While i < 1000
            strLine = objFile.ReadLine
            If InStr(strLine, " 0.0kt") <> 29 Then 'Sample was 29 on my machine, not 28.
                newString = newString & strLine & vbCrLf
            End If
            i = i + 1
        Loop
    LoopASD:    objFile.Close
    Set objFile = objFSO.OpenTextFile("C:\Users\v.doynov\Desktop\nd.txt", ForWriting)
    objFile.Write newString
    objFile.CloseEnd Sub

Он проверяет, есть ли If InStr(strLine, " 0.0kt") <> 29 Then и если он Таким образом, он присоединяет строку к newString. В конце сохраняется newString.

jefti ответил: 28 апреля 2018 в 11:49
newString = newString & strLine & vbCrLf Эта строка, похоже, заменяет существующую строку той же строкой (поскольку в качестве входных данных используется strLine). Если я заменю strLine на "", я все равно получаю пустой файл.