How to put lines with certain text (from a file) in an array
Hi Bart,
For your test the Join and the Split are not necessary, simply
arr2 = Filter(Filter(arr1, "layer_", True, vbTextCompare), _
"layer_3", False, vbTextCompare)
With small files (up to say 0.3Mb) and large files 10Mb I didn't find much
difference in the two methods. Barely any measurable difference with the
small files although the loop was always slightly faster with the large
files.
Curiously though the loop was much faster with medium size files of 1Mb. The
Filter method was only slightly slower with a 1Mb file vs a 10Mb file (not
pro-rata at all). I don't understand the timing anomalies I got.
Regards,
Peter T
"RB Smissaert" wrote in message
...
I got the method with Join and Filter about twice as slow.
This is with testing on 1 Mb test file, with the 5 line repeating sequence
as in the OP:
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private lStartTime As Long
Function OpenTextFileToString(strFile As String) As String
Dim hFile As Long
On Error GoTo ERROROUT
hFile = FreeFile
Open strFile For Binary As #hFile
OpenTextFileToString = Space(LOF(hFile))
Get hFile, , OpenTextFileToString
Close #hFile
Exit Function
ERROROUT:
If hFile 0 Then
Close #hFile
End If
End Function
Sub Test()
Dim i As Long
Dim n As Long
Dim str As String
Dim arr1
Dim str2 As String
Dim arr2
Dim bJoin As Boolean
bJoin = True
str = OpenTextFileToString("C:\testfile.txt")
arr1 = Split(str, vbCrLf)
StartSW
If bJoin Then
str2 = Join(Filter(Filter(arr1, "layer_", True, vbTextCompare), _
"layer_3", False, vbTextCompare), vbCrLf)
arr2 = Split(str2, vbCrLf)
Else
ReDim arr2(0 To UBound(arr1)) As String
For i = 0 To UBound(arr1)
If InStr(1, arr1(i), "layer_", vbBinaryCompare) 0 And _
InStr(1, arr1(i), "layer_3", vbBinaryCompare) = 0 Then
arr2(n) = arr1(i)
n = n + 1
End If
Next i
ReDim Preserve arr2(0 To n - 1) As String
End If
StopSW
'to check we got it right
For i = 0 To 3
MsgBox arr2(i), , i
Next i
End Sub
Sub StartSW()
lStartTime = timeGetTime()
End Sub
Function StopSW(Optional bMsgBox As Boolean = True, _
Optional vMessage As Variant, _
Optional lMinimumTimeToShow As Long = -1) As Variant
Dim lTime As Long
lTime = timeGetTime() - lStartTime
If lTime lMinimumTimeToShow Then
If IsMissing(vMessage) Then
StopSW = lTime
Else
StopSW = lTime & " - " & vMessage
End If
End If
If bMsgBox Then
If lTime lMinimumTimeToShow Then
MsgBox "Done in " & lTime & " msecs", , vMessage
End If
End If
End Function
RBS
"RB Smissaert" wrote in message
...
OK, it is a one-liner, but is it faster than Instr in a loop?
Will test in a bit, unless somebody else will do that ...
RBS
"Rick Rothstein" wrote in message
...
Yes, very good Peter, that does seem to work. "Pretty cool" back at you.
--
Rick (MVP - Excel)
"Peter T" <peter_t@discussions wrote in message
...
That's pretty cool Rick!
you can't use this method to only output "layer_1" and "layer_2"
skipping over "layer_3"...
maybe -
LinesOut = Join(Filter(Filter(LinesIn, "layer_", True, vbTextCompare),
_
"layer_3", False, vbTextCompare), vbCrLf)
Regards,
Peter T
"Rick Rothstein" wrote in message
...
The following code will output all the lines containing the text
"layers_" **anywhere** within them. Notice that you can't pick and
choose a subset of all the "layer_" lines; that is, you can't use this
method to only output "layer_1" and "layer_2" skipping over
"layer_3"... the search text that gets used in the Filter function
works like that in the InStr function. Oh, and change the file names
for the input and output files.
Sub ReadProcessOutput()
Dim FileNum As Long
Dim TotalFile As String
Dim LinesOut As String
Dim LinesIn() As String
FileNum = FreeFile
Open "d:\temp\Test.txt" For Binary As #FileNum
TotalFile = Space(LOF(FileNum))
Get #FileNum, , TotalFile
Close #FileNum
LinesIn = Split(TotalFile, vbCrLf)
LinesOut = Join(Filter(LinesIn, "layer_", True, vbTextCompare),
vbCrLf)
FileNum = FreeFile
Open "d:\temp\OutTest.txt" For Output As #FileNum
Print #FileNum, LinesOut
Close #FileNum
End Sub
--
Rick (MVP - Excel)
"RB Smissaert" wrote in message
...
Function OpenTextFileToString(strFile As String) As String
Dim hFile As Long
On Error GoTo ERROROUT
hFile = FreeFile
Open strFile For Binary As #hFile
OpenTextFileToString = Space(LOF(hFile))
Get hFile, , OpenTextFileToString
Close #hFile
Exit Function
ERROROUT:
If hFile 0 Then
Close #hFile
End If
End Function
Sub Test()
Dim i As Long
Dim n As Long
Dim str As String
Dim arr1
Dim arr2() As String
str = OpenTextFileToString("C:\testfile.txt")
arr1 = Split(str, vbCrLf)
ReDim arr2(0 To UBound(arr1)) As String
For i = 0 To UBound(arr1)
If InStr(1, arr1(i), "layer_", vbBinaryCompare) 0 Then
arr2(n) = arr1(i)
n = n + 1
End If
Next i
ReDim Preserve arr2(0 To n - 1) As String
'to check we got it right
For i = 0 To UBound(arr2)
MsgBox arr2(i), , i
Next i
End Sub
RBS
"Varun" wrote in message
...
Guys,
I'd like to open and parse a file such that when I parse, only lines
with
certain text in them get included into my array. How can I
accomplish this?
For example, let say that file contents are as follows:
text in line 1
text in line 2
layer_1
layer_2
layer_3
I'd like to save the lines with layer_1, layer_2, and layer_3 in my
array
named line.
Here's what I have so far - what should I do next?
Sub geomsasciiparse()
Dim Buf() As String
Dim logical_layer As Variant
Dim line() As String
Dim objFSO As Object
Dim objGeomsAsciiFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objGeomsAsciiFile = objFSO.OpenTextFile(MentDesContPath &
"\geoms_ascii")
strBuffer = objGeomsAsciiFile.Readline
Do While Not objGeomsAsciiFile.AtEndOfStream
If InStr(strBuffer, "layer") = 1 Then
End If
Thanks for help.
|