View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default VBA - array or collection literals?

Marcus,

Here's some code from my standard library that will do what you want, if I
understand your question properly:


Function SplitMultiDelims(Text As String, DelimChars As String) As String()
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''
' SplitMutliChar
' Works list SPLIT but supports multiple delimiter characters, which
' together make up the string DelimChars. Text is the text to split
' apart using the characters of DelimChars. Returns an array of the
' split works of Text. Supports only single character delimiters.
' See SplitMutliDelimsEX for multi-character delimiters.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long

' if Text is empty, get out
If Len(Text) = 0 Then
Exit Function
End If


' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
ReDim Arr(1 To Len(Text))

I = 0
N = 0
Pos1 = 1

For N = Pos1 To Len(Text)
For M = 1 To Len(DelimChars)
If StrComp(Mid(Text, N, 1), Mid(DelimChars, M, 1), vbTextCompare) =
0 Then
I = I + 1
Arr(I) = Mid(Text, Pos1, N - Pos1)
Pos1 = N + 1
N = N + 1
End If
Next M
Next N

If Pos1 <= Len(Text) Then
I = I + 1
Arr(I) = Mid(Text, Pos1)
End If


' chop off unused array elements
ReDim Preserve Arr(1 To I)
SplitMultiDelims = Arr

End Function

Function IsArrayAllocated(Arr As Variant) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''
' IsArrayAllocated
' Returns True or False indicating whether a dynamic
' array is allocated. It supports arrays that are the
' result of functions like Split in which case the
' LBound is greater than the UBound for unallocated
' arrays.
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''
IsArrayAllocated = (IsArray(Arr) = True) And _
(IsError(LBound(Arr, 1)) = False) And _
(LBound(Arr, 1) <= (UBound(Arr, 1)))

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''
You can then test the code with

Sub AAAA()

Const C_DELIM_CHARS = "|:,;" ' for example
Dim Arr() As String
Dim S As String
Dim N As Long

S = "a|bc;def:ghij;klmno|"

Arr = SplitMultiDelims(Text:=S, DelimChars:=C_DELIM_CHARS)
If IsArrayAllocated(Arr) = True Then
For N = LBound(Arr) To UBound(Arr)
Debug.Print Arr(N)
Next N
End If

End Sub

The C_DELIM_CHARS contants should contain all the characters you want to use
a delimiters, and nothing else (e.g., the delimiters aren't themselves
delimited).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)




"Marcus Schöneborn" wrote in message
. uni-frankfurt.de...
Currently, I have written a function to do some sort of pattern
matching:

Dim delims As New Collection
delims.Add " <"
delims.Add "@"
delims.Add ""

Dim tokens As Collection
tokens = UnDelimit("Marcus Schöneborn ", delims)
? tokens.Count ' 4
? tokens(1) ' "Marcus Schöneborn"
? tokens(2) ' "divZero"
? tokens(3) ' "googlemail.com"
? tokens(4) ' ""

Is there a simpler way to call this by making a "literal" collection,
think of it like

Dim tokens As Collection
tokens = UnDelimit("...", {" <", "@", ""})

Or is there a way to get C-like function varargs, so I can use it like

Dim tokens As Collection
tokens = UnDelimit("...", " <", "@", "")

Or, alternatively: is there a way to make the VBScript.RegExp object
support . matching newlines?