はじめ
問題は余分なキャリッジリターンたことが最初に現れました。削除された最初のソリューションは、孤立したCRを検索して削除しました。これは有益な効果がなかったので、問題は余分なキャリッジリターンではないことが明らかになりました。本当の位置付けを適切に評価できるように、以下の分析コードを提供しました。この分析ルーチンからの出力が元の質問に追加されました。この出力を確認すると、真の問題が明らかになりました。
これらの知見に基づく改訂された解決策は、分析コードの下にあります。
分析
あなたはモジュールに以下のコードを含める必要があります。ルーチンには "DiagInfo"という名前のワークシートが必要です。
コードは、入力ファイルから約1Mbのブロックをループします。これは、各ブロックを行終端文字として機能する任意の制御文字で行に分割します。ブロックごとに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ですが、出力ファイルは10倍多くなります。私は1メガバイトがノートパッドで簡単にアクセスできるファイルを私に与えることがわかります。
出力は次のようになります。最初の7つの文字は空白が続く行番号です
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には、最後に発生したファイルおよび行番号が含まれます。
このルーチンは、現在の出力ファイル番号と最後の行番号が100の倍数であることを示す最後の行と、粗進行インジケータとしてワークシート "DiagInfo"を使用します。63Mbのテストファイルでは、
これは、私たちが扱っていることを教えてくれるので、それに応じて私たちが計画することができます。
- 空白行の数が多い：分析出力の
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バイトのブロックで読み取ります。長い文字列の更新にはかなりのオーバーヘッドがあります。限られた実験では、10万が許容できる妥協であることが示唆されている。ブロックの最後の文字が制御文字である場合、ルーチンは、最後の文字が制御文字でない限り、ブロックに別の文字を追加するループを行います。これにより、制御文字のシーケンスが2つのブロックに分割されないようになります。ルーチンは最初に、CR LF CR LFをCR LFに置き換えて、空白行がなくなるまでループします。次に、ルーチンはCRで始まらないLFを探します。見つかったものはスペースで置き換えられます。空白行が多数あり、余分な数字がLFの63Mbファイルでは、ルーチンは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
問題はとてもひどく説明されているので、私はあなたが-2を持っていると仮定します。 「一部の行に「改行」や「改行」が含まれているとはどういう意味ですか？ランダムなキャリッジリターンが追加されていることを除いて、ファイルは良好ですか？余分なキャリッジリターンを削除してファイルを修正できるようにしましたか？アドレスなどの文字列にキャリッジリターンが含まれているため、そのようなキャリッジリターンを「¶」、ASC（182）などに置き換えることによってファイルを修正する必要があることを意味していますか？見た目と分割線の例を教えてください。 –
詳細については元のメッセージを編集しました。すべてのキャリッジリターンと改行をファイルから削除します。それらはスペースで置き換えることも、単に削除することもできます。 – dmuk