Введение
Сначала выяснилось, что проблема заключалась в дополнительном возврате каретки. Первое решение (которое было удалено) искало одиночные КР и удалило их. Это не имело положительного эффекта, поэтому стало ясно, что проблема не в дополнительных возвратах каретки. Я предоставил код анализа ниже, чтобы мы могли правильно оценить истинную ситуацию. Вывод этой процедуры анализа был добавлен к исходному вопросу. Обзор этого вывода показал, что истинные проблемы были:
- Большое количество пустых строк.
- дополнительные переводы строки.
Пересмотренное решение, основанное на этих выводах, находится под кодом анализа.
Анализ
Вам необходимо включить приведенный ниже код в модуль. Для этой подпрограммы требуется рабочий лист с именем "DiagInfo".
Код зацикливает блоки чтения приблизительно 1 Мбайт из входного файла. Он разбивает каждый блок на строки с любым управляющим символом, служащим ограничителем строки. Создает один выходной файл на блок.
В верхней части процедуры вы найдете:
' ###### Replace names as required
FileInNameRoot = "TestSplitLine In"
FileOutNameRoot = "TestSplitLine Out"
Входной файл: FileInNameRoot & ".txt".
Выходные файлы имеют имена: FileOutNameRoot & " 001.txt", FileOutNameRoot & " 002.txt", FileOutNameRoot & " 003.txt" и т. Д.
При желании вы можете изменить размер блока с 1 Мб. Процедура выполняется немного быстрее с размером блока 1 000 000, но вы получаете в десять раз больше выходных файлов. Я обнаружил, что 1 Мб дает мне файлы, к которым можно легко получить доступ с помощью NotePad.
Вывод выглядит так:
000001 FIELD_NAME1|FIELD_NAME2|FIELD_NAME3 13 10
000002 John|He likes food|1002 13 10
000003 Jake|He eats food|1004 13 10
000004 Jake|He eats food and 13
000005 likes swimming|1003 13 10
000006 John|He likes food|1002 13 10
000007 Jake|He eats food|1004 13 10
000008 Jake|He eats food and 20 27 0 4
Первые семь символов - это номер строки, за которым следует пробел. Строка заканчивается любым управляющим символом. Отображаемые символы из входного файла выводятся без изменений. Каждый управляющий символ выводится в виде пробела, за которым следует его кодовое значение. Большинство строк заканчивается 13 10 (CR LF), но строка 4 заканчивается 13 (CR), а строка 8 заканчивается 20 27 0 4 (DC4 ESC NUL EOT).
Рабочий лист "DiagInfo" выглядит так:
First Last
String File Line File Line
13 10 1 1 66 5786
13 1 4 66 5666
20 27 0 4 1 8 66 5670
Столбец A содержит каждую различную строку управляющих символов, найденную процедурой. Столбцы B и C содержат файл и номер строки первого вхождения. Столбцы D и E содержат файл и номер строки последнего вхождения.
Подпрограмма использует рабочий лист "DiagInfo" в качестве грубого индикатора прогресса, где последняя строка показывает текущий номер выходного файла и номер последней строки, кратный 100. С моим тестовым файлом 63 Мб подпрограмма заняла 2 минуты.
Это скажет нам, с чем мы имеем дело, и позволит нам планировать соответственно.
Option Explicit
Sub AnalyseFileAndSplitIntoBlocks()
Dim Block As String
Dim BlockLen As Long
Dim CtrlChr As Long
Dim CtrlChrStg As String
Dim FileIn As Object
Dim FileInNameRoot As String
Dim FileOut As Object
Dim FileOutNameRoot As String
Dim Found As Boolean
Dim FSO As Object
Dim LineOut As String
Dim NumFileOut As Long
Dim NumLine As Long
Dim PathCrnt As String
Dim PosCrnt As Long
Dim PosStart As Long
Dim RowDiagCrnt As Long
Dim RowDiagNext As Long
Dim StartTime As Single
Dim TrailingFromLastBlock As String
StartTime = Timer
' ###### Replace names as required
FileInNameRoot = "TestSplitLine In"
FileOutNameRoot = "TestSplitLine Out"
With Worksheets("DiagInfo")
.Activate
.Cells.EntireRow.Delete
.Range("B1:C1").Merge
With .Range("B1")
.Value = "First"
.HorizontalAlignment = xlCenter
End With
.Range("D1:E1").Merge
With .Range("D1")
.Value = "Last"
.HorizontalAlignment = xlCenter
End With
.Range("A2").Value = "String"
.Range("B2").Value = "File"
.Range("C2").Value = "Line"
.Range("D2").Value = "File"
.Range("E2").Value = "Line"
.Range("B2:E2").HorizontalAlignment = xlRight
.Range("A1:E2").Font.Bold = True
RowDiagNext = 3
.Cells(RowDiagNext, 1).Select
End With
ActiveWindow.FreezePanes = False
ActiveWindow.FreezePanes = True
PathCrnt = ActiveWorkbook.Path
Set FSO = CreateObject("Scripting.FileSystemObject")
BlockLen = 1000000
Set FileIn = FSO.OpenTextFile(PathCrnt & "\" & FileInNameRoot & ".txt", 1, 0)
' 1 = Read. 0 = ASCII file
NumFileOut = 0
TrailingFromLastBlock = ""
Do While FileIn.AtEndOfStream <> True
Block = TrailingFromLastBlock & FileIn.read(BlockLen)
Do While True
' Ensure block not split in middle of a string of control characters
If (Right(Block, 1) < " " Or Right(Block, 1) = Chr(127)) And _
FileIn.AtEndOfStream <> True Then
' The last character of block is a control character. Get another
Block = Block & FileIn.read(1)
Else
Exit Do
End If
Loop
With Worksheets("DiagInfo")
NumFileOut = NumFileOut + 1
.Cells(RowDiagNext, 2).Value = NumFileOut
NumLine = 1
.Cells(RowDiagNext, 3).Value = NumLine
End With
Set FileOut = FSO.CreateTextFile(PathCrnt & "\" & FileOutNameRoot & " " & _
Right("000" & NumFileOut, 3) & ".txt", True, False)
' True = Can overwrite. False = ASCII
PosStart = 1 ' Start of first line
PosCrnt = 1
Do While PosCrnt <= Len(Block)
If Mid(Block, PosCrnt, 1) < " " Or _
Mid(Block, PosCrnt, 1) = Chr(127) Then
' Have found a control character.
LineOut = Mid(Block, PosStart, PosCrnt - PosStart)
' Build display string of control character and
' any subsequent control characters.
CtrlChrStg = ""
Do While True
CtrlChrStg = CtrlChrStg & " " & Asc(Mid(Block, PosCrnt, 1))
PosCrnt = PosCrnt + 1
If PosCrnt > Len(Block) Then
' This block finished
Exit Do
End If
If Mid(Block, PosCrnt, 1) < " " Or _
Mid(Block, PosCrnt, 1) = Chr(127) Then
' Another control character
Else
' First display character of next line
Exit Do
End If
Loop
' Search for control character string in worksheet DiagInfo
With Worksheets("DiagInfo")
Found = False
For RowDiagCrnt = 3 To RowDiagNext - 1
If .Cells(RowDiagCrnt, 1).Value = CtrlChrStg Then
Found = True
Exit For
End If
Next
If Not Found Then
' Previously unknown string of control characters
RowDiagCrnt = RowDiagNext
RowDiagNext = RowDiagNext + 1
.Cells(RowDiagNext, 1).Select
.Cells(RowDiagCrnt, 1).Value = "'" & CtrlChrStg
' First occurrence
.Cells(RowDiagCrnt, 2).Value = NumFileOut
.Cells(RowDiagCrnt, 3).Value = NumLine
End If
' Last occurrence
.Cells(RowDiagCrnt, 4).Value = NumFileOut
.Cells(RowDiagCrnt, 5).Value = NumLine
End With
FileOut.writeline Right("00000" & NumLine, 6) & " " & _
LineOut & CtrlChrStg
PosStart = PosCrnt ' Start of current line
NumLine = NumLine + 1
If NumLine Mod 100 = 0 Then
With Worksheets("DiagInfo")
.Cells(RowDiagNext, 2).Value = NumFileOut
.Cells(RowDiagNext, 3).Value = NumLine
End With
End If
Else
PosCrnt = PosCrnt + 1
End If
Loop
FileOut.Close
' Save trailing characters for next line
TrailingFromLastBlock = Mid(Block, PosStart, Len(Block) - PosStart + 1)
Loop
FileIn.Close
With Worksheets("DiagInfo")
.Cells(RowDiagNext, 2).Value = ""
.Cells(RowDiagNext, 3).Value = ""
.Cells(3, 1).Select
.Cells.Columns.AutoFit
End With
Debug.Print Timer - StartTime
End Sub
Пересмотренное решение
Обзор результатов анализа показал, что истинные проблемы были:
- Большое количество пустых строк.
- дополнительные переводы строки.
В тексте были также вкладки, но спрашивающий решил, что это не проблема и их следует сохранить. Спрашивающий хотел, чтобы пустые строки были удалены, а переводы строк были заменены пробелами.
Подпрограмма ниже читает входные файлы в блоках по 100 000 байт. Существенные накладные расходы связаны с обновлением длинных строк. Ограниченные эксперименты показывают, что 100 000 - приемлемый компромисс. Если последний символ блока является управляющим символом, то процедура зацикливается, добавляя еще один символ в блок, пока последний символ не станет управляющим символом. Это гарантирует, что ни одна последовательность управляющих символов не будет разбита на два блока. Сначала процедура зацикливается, заменяя CR LF CR LF на CR LF до тех пор, пока не останется пустых строк. Затем процедура ищет LF с, за которыми не следует CR с. Все найденные заменяются пробелами. В файле размером 63 Мб с большим количеством пустых строк и дополнительными LF с подпрограмме потребовалось 22 секунды, чтобы выполнить свою задачу.
Единственные операторы, требующие изменения, находятся в начале процедуры.
Option Explicit
Sub RemoveUnwantedCtrlChars()
Dim Block As String
Dim BlockLen As Long
Dim FileIn As Object
Dim FileInName As String
Dim FileOut As Object
Dim FileOutName As String
Dim FSO As Object
Dim PathCrnt As String
Dim PosCRLF As Long
Dim PosLF As Long
Dim PosLastCRLF As Long
Dim PosLastLF As Long
Dim StartTime As Single
StartTime = Timer
' ## This assumes the input file is in the same folder
' ## as the workbook containing this macro.
PathCrnt = ActiveWorkbook.Path
' ###### Replace names as required.
FileInName = "TestSplitLine In.txt"
FileOutName = "TestSplitLine Out.txt"
Set FSO = CreateObject("Scripting.FileSystemObject")
BlockLen = 100000
Set FileIn = FSO.OpenTextFile(PathCrnt & "\" & FileInName, 1, 0)
' 1 = Read. 0 = ASCII file
Set FileOut = FSO.CreateTextFile(PathCrnt & "\" & FileOutName, True, False)
' True = Can overwrite. False = ASCII
Do While FileIn.AtEndOfStream <> True
Block = FileIn.Read(BlockLen)
Do While True
' Ensure block not split in middle of a string of control characters
If (Right(Block, 1) < " " Or Right(Block, 1) = Chr(127)) And _
FileIn.AtEndOfStream <> True Then
' The last character of block is a control character. Get another
' character
Block = Block & FileIn.Read(1)
Else
Exit Do
End If
Loop
' Remove all blank lines
Do While InStr(1, Block, vbCr & vbLf & vbCr & vbLf) <> 0
Block = Replace(Block, vbCr & vbLf & vbCr & vbLf, vbCr & vbLf)
Loop
' Find all lone LFs and replace by " "
PosLF = 1
PosCRLF = 1
Do While True
PosLastLF = PosLF
PosLastCRLF = PosCRLF
PosLF = InStr(PosLF, Block, vbLf)
PosCRLF = InStr(PosCRLF, Block, vbCr & vbLf)
If PosLF = 0 Then
' No more LFs in this block
Exit Do
ElseIf PosCRLF <> 0 And PosLF > PosCRLF Then
' Have LF of CR LF. No action required
PosLF = PosLF + 1
PosCRLF = PosLF
Else
' Have a lone LF
Block = Mid(Block, 1, PosLF - 1) & " " & Mid(Block, PosLF + 1)
' Move CRLF pointer back to position of replaced LF
PosCRLF = PosLF
End If
Loop
PosLF = 1
FileOut.write Block
Loop
FileIn.Close
FileOut.Close
Debug.Print Timer - StartTime
End Sub