Split() [Resolved by da_silvy]

Now I have your attention...


I need a Split() function on steroids.

I am reading an EDI file into a string and I want split the segments into a String array.

The segement terminator is the apostophe
eg:

DST+980219:1510++++1200'
PDN+A11813+1200:1200+980209:1932'
PDN+A11767+1200:1200+980202:1802'
PDN+A11767+120:120+980202:1801'
PDN+MV291644+1200:1200+980213:0745'
PDN+MV283966+1200:1200+980209:0755'
PDN+MV272008+1200:1200+980129:1339'
DEL+::980219:0700+2400:LIT255::4'
DEL+::980223:2030+1200:LIT267::4'
DEL+::980302:2030+1200:LIT280::4'
TCO+:MCTN++1200'
ADI+3'

Although this example is one segment per line, that is not the case. The EDI file is one long string.

OK, I can hear you thinking "just use Split()" well, it's not that easy because although I want to split on the apostophe, if the apostophe has a ? in front of it, it is NOT a segment terminator.


This is what I'm using at the moment:
(you might recognise it as being based on the "VB6 string funtions in VB5" example from the MSDN site - although I am now using VB6)

Code:

---

Public Function SplitSegments(ByVal sIn As String, SegmentTerminator As String, ReleaseIndicator As String) As Variant
    Dim sRead As String
    Dim sOut() As String
    Dim nC As Long
   
    sRead = ReadUntil(sIn, SegmentTerminator, ReleaseIndicator)
    Do
        ReDim Preserve sOut(nC)
        sOut(nC) = sRead
       
        nC = nC + 1
        sRead = ReadUntil(sIn, SegmentTerminator, ReleaseIndicator)
        DoEvents
    Loop While sRead <> ""
   
    ReDim Preserve sOut(nC)
    sOut(nC) = sIn
    SplitSegments = sOut
End Function
Public Function ReadUntil(ByRef sIn As String, _
      sDelim As String, esc As String, Optional bCompare As VbCompareMethod _
    = vbBinaryCompare) As String
    Dim nPos As Long
    Dim xPos As Long
   
    xPos = InStr(1, sIn, esc & sDelim, bCompare)
    nPos = InStr(1, sIn, sDelim, bCompare)
   
   
    If xPos > 0 Then
      'escaped appostrophe has been found
      If xPos < nPos Then
        nPos = InStr(xPos + 2, sIn, sDelim, bCompare)
      End If
       
    End If
   
    If nPos > 0 Then
        ReadUntil = Left(sIn, nPos - 1)
        sIn = Mid(sIn, nPos + Len(sDelim))
    End If


End Function

---

It works fine for small files but files can be up to 1.6 MB and it becomes VERY slow :(


Any ideas how I can speed things up considerably?

Thanks

Try this man:

VB Code:

mStr = "DST+980219:1510++++1200'PDN+A11813+1200:1200+980209:1932?'PDN+A11767+1200:1200+980202:1802'PDN+A11767+120:120+980202:1801'PDN+MV291644+1200:1200+980213:0745'PDN+MV283966+1200:1200+980209:0755'PDN+MV272008+1200:1200+980129:1339'DEL+::980219:0700+2400:LIT255::4'DEL+::980223:2030+1200:LIT267::4'DEL+::980302:2030+1200:LIT280::4'TCO+:MCTN++1200'ADI 3 '"
mStr = Replace(mStr, "?'", "¿")
splitString = Split(mStr, "'")
For i = 0 To UBound(splitString)
    splitString(i) = Replace(splitString(i), "¿", "?'")
Next

That is how i tested it, very fast ;)

Does it work for you/your needs?

That stuffed up the original string.

I whacked a ?' in there to test it

VB Code:

mStr = "DST+980219:1510++++1200'PDN+A11813+1200:1200+980209:1932?'PDN+A11767+1200:1200+980202:1802" & _
       "'PDN+A11767+120:120+980202:1801'PDN+MV291644+1200:1200+980213:0745'PDN+MV283966+1200:1200+" & _
       "980209:0755'PDN+MV272008+1200:1200+980129:1339'DEL+::980219:0700+2400:LIT255::4'DEL+::9802" & _
       "23:2030+1200:LIT267::4'DEL+::980302:2030+1200:LIT280::4'TCO+:MCTN++1200'ADI 3'"
mStr = Replace(mStr, "?'", "¿")
splitString = Split(mStr, "'")
For i = 0 To UBound(splitString)
    splitString(i) = Replace(splitString(i), "¿", "?'")

Or something along these lines ;

VB Code:

Private Function superSplit(strString As String, strDelimeter As String) As String()
    Dim retVal() As String, i As Long, n As Long, recording As Boolean
    ReDim retVal(0)
    If InStr(strString, "'") <> 0 Then retVal(0) = Mid(strString, 1, InStr(strString, "'") - 1)
    For i = 2 To Len(strString)
        If (Mid(strString, i, 1) = strDelimeter) And (Mid(strString, i - 1, 1) <> "?") Then
            Debug.Print "ok " & recording
            recording = Not recording
            If recording Then
                n = i + 1
            Else
                recording = False
                ReDim Preserve retVal(UBound(retVal) + 1)
                retVal(UBound(retVal)) = Mid(strString, n, i - 1)
            End If
        End If
    Next
    superSplit = retVal
End Function

Though I think da_silvy's approach is the easiest ...

Thank you you irish fool :p

j/k

Thanks da_silvy I read your PM, I was just testing it.

It's VERY neat and like you say; VERY fast

Processing time reduced from about 1½ hours down to 2 minutes!

I'm impressed!

Thanks


What made you think of that method?

Fair ****s to ya. 90 minutes down to 2. Christ :)

Thanks very much

Dunno what made me think of it.

I thought that it would be easier to split it if there were no ?' things in the string. So i thought I could replace them, then split it, then replace the introduced character with ?' again

i used ¿ as a replacement, because i don't think that would appear in the EDI. (Alt + 1, 6, 8)

Glad I could help

BTW: Thanks for the credit in the thread topic :)

Quote:

---

Originally posted by plenderj
Fair ****s to ya. 90 minutes down to 2. Christ :)

---

hehehhehe

Not bad eh?

For someone who gives up easier than a seal? :p