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

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

0 голосов
/ 22 мая 2018

У меня очень большой набор файлов журналов с данными 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 ASD

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\x\170418.log", ForReading)

x = 1

Do
Do While i < 1000

        strline = objFile.ReadLine
         If InStr(strline, " 0.0kt") = 28 Then
            strline = "" & vbCrLf

        End If
    i = i + 1

Loop

'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 = x

Loop

ASD:

objFile.Close

Set objFile = objFSO.OpenTextFile("C:\x\170418.log", ForWriting)
objFile.Write strline

objFile.Close

End Sub

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

Спасибо

Ответы [ 2 ]

0 голосов
/ 22 мая 2018

Глядя на ваш пример текста, я думаю, что любая строка, содержащая ; 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 ofileno

End Sub
0 голосов
/ 22 мая 2018

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

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
    Loop

ASD:

    objFile.Close
    Set objFile = objFSO.OpenTextFile("C:\Users\v.doynov\Desktop\nd.txt", ForWriting)
    objFile.Write newString
    objFile.Close

End Sub

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

...