Sub sb_Parse() Dim tDlm() As Byte, tPos As Byte, tLB As Byte, tUB As Byte, tBeg As Byte, tEnd As Byte, i As Byte Dim sSrc$, sDlm$, sTgt$() 'sSrc = "012303456078" sSrc = "0123-03456-078" sDlm = "-" tPos = 0 tBeg = 1 tLB = 1: tUB = 0 Do tPos = InStr(tPos + 1, sSrc, sDlm) Select Case tPos > 0 Case True tUB = tUB + 1 tEnd = tPos - 1 ReDim Preserve tDlm(1 To 2, tLB To tUB) tDlm(1, tUB) = tBeg tDlm(2, tUB) = tEnd tBeg = tPos + 1 Case False Exit Do End Select Loop Select Case tUB > 0 Case True If tLB <> LBound(tDlm, 2) Or tUB <> UBound(tDlm, 2) Then Stop tUB = tUB + 1 ReDim Preserve tDlm(1 To 2, tLB To tUB) tDlm(1, tUB) = tDlm(2, tUB - 1) + 2 tDlm(2, tUB) = Len(sSrc) For i = tLB To tUB ReDim Preserve sTgt(i) sTgt(i) = Mid(sSrc, tDlm(1, i), tDlm(2, i) - tDlm(1, i) + 1) Debug.Print sTgt(i) Next Case False Debug.Print "Nothing to parse..." End Select End Sub |