View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default 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.