J
Jim Luedke
This is in response to a recent thread:
http://groups.google.com/group/micr...read/thread/7316e138ece6d64e/b781ac69e8210f03
Here is code to parse a function's param string.
Namely, given a string of form "aaa,bbb,ccc", return an array
{"aaa","bbb","ccc"}.
Easy, yes, but given *this* string:
=x("abc",123,y(999,"xyz"),z(101,y(999,"xyz")))
return:
"abc"
123
y(999,"xyz")
z(101,y(999,"xyz"))
(However, this being the first time I've submitted anything this large
thru Google, much of the below, thanks to Google, is a complete
nightmare.
The Google input box is much tinier than the thread's posted screen;
worse it's in G.D. proportional font, and none of the CR/LFs are where
they should be.
If things really are unreadable, let me know and maybe I'll try to
clean up things more.)
***
This stuff is alpha, or even pre-alpha. It likely needs more testing.
OK, sports fans, here it is:
***
'Sample usage.
Dim VParams() As Variant
Call ReduceToParamString(Formula)
If Not ParseParamString(Formula, VParams) Then
MsgBox "Can't parse formula syntax."
End If
'The routines.
Public Sub AddMembers(ByRef ArrayToAddTo() As Variant, ByRef NewMembers
() As Variant)
'Action: Add everyone in param 2 to param 1.
'Note: I'm no VBA expert, so there may well way be a
'better way
' of doing this. For one thing, I just noticed I could
' ReDim array 1 just once, knowing the size of array 2.
Dim i As Long, L As Long
Dim Member As Variant
If HasMembers_V(ArrayToAddTo) Then
L = LBound(ArrayToAddTo)
i = UBound(ArrayToAddTo) + 1
End If
For Each Member In NewMembers
ReDim Preserve ArrayToAddTo(L To i)
ArrayToAddTo(i) = Member
i = i + 1
Next
End Sub
Public Function Arrayize(ByVal S As String, _
ByVal Delimiter As String, _
ByRef Arrray() As Variant) As Boolean
'Action: Given a string containing one or more occurrences of
' substring Delimiter, parse the intervening substrings into
' an array.
Dim i As Integer
Dim NW As String
While NextWord(S, NW, Delimiter)
ReDim Preserve Arrray(0 To i)
Arrray(i) = NW
Arrayize = True
i = i + 1
Wend
End Function
Private Function FindBalancingRightParen(ByRef S As String, ByVal
PosLeftParen As Integer, _
ByRef Remainder As String) As Boolean
'Action: We have been told that formula-like string S has a left
' paren. We are given the position of the FIRST left paren.
' Find its corresponding right paren. If found, return True,
' the balanced portion of S, and the remainder to the right
' of the balancing ')'.
'Note: I believe that, upon return, the caller should find our
' remainder to be one of only two things:
' - Empty.
' - Beginning with a comma.
Dim i As Integer, LenS As Integer, NumLeftParens As Integer,
NumRightParens As Integer
LenS = Len(S)
'Just for peace of mind:
If LenS > PosLeftParen + 1 Then
'We've been told there's a leading left paren, so this
'initialization is a no-brainer:
NumLeftParens = 1
For i = PosLeftParen + 1 To LenS
Select Case Mid(S, i, 1)
Case ")"
IncI NumRightParens
Case "("
IncI NumLeftParens
End Select
If NumRightParens = NumLeftParens Then
'We're there.
Remainder = Right(S, LenS - i)
'Since the input string contains the left paren, make sure
'the output string includes the right ditto.
S = Left(S, i)
FindBalancingRightParen = True
Exit Function
End If
Next
End If
End Function
Public Function HasMembers_V(ByRef Aray() As Variant) As Boolean
'Action: Return, simply, whether an array has any members.
'Notes: - Variant flavor. Use the _S version for strings.
' - Where's VBA on this? These constructions all seem to FAIL:
' - IsArray().
' - IsEmpty() returns f-ing FALSE if the array has no
' members. Huh??? What could possibly be "True" about an
' un-populated array?
' - IsNull() ditto.
' - LBound() & UBound() seem to throw an error too. Wouldn't
' you think setting UBound to, like, -1 when there's no
' members would be a good way to handle this condition? I
' mean, I've seen it occur. Am I thinking of another
' language?
On Error GoTo VBA_54_Where_Are_You
If LBound(Aray) > 0 Then
End If
HasMembers_V = True
Exit Function
VBA_54_Where_Are_You:
'"There's a holdup in the Bronx, Brooklyn's broken out in fights..."
End Function
Public Function LastPos(ByVal InWhat As String, _
ByVal OfWhat As String) As Integer
'Action: Return the position of the last occurrence, if any,
' of OfWhat in InWhat.
'Note: This needs to be rewritten to use InStrRev; would be
' much more efficient.
Dim i As Integer, L As Integer
If InWhat <> "" Then
L = Len(OfWhat)
For i = Len(InWhat) To 1 Step -1
If Mid(InWhat, i, L) = OfWhat Then
LastPos = i
Exit Function
End If
Next
End If
End Function
Public Function LastPosBefore(ByVal InWhat As String, ByVal OfWhat As
String, ByVal Before As Integer) As Integer
'Action: Return the position of the last OfWhat in InWhat before
' position Before.
LastPosBefore = LastPos(Left(InWhat, Before - 1), OfWhat)
End Function
Public Function NextWord(ByRef OrigStringWhichBecomesTheRemainder As
String, _
ByRef ReturnedNextWord As String, _
Optional ByVal Delim As String) As Boolean
'Action: Do the following:
' - Trim param 1.
' - If Param 1 contains a space, return the first word, set
' Param 1 to the right-hand remainder, and trim *it*.
' - If Param 1 contains no space, return all of Param 1 as
' the first word, and set Param 1 to empty string.
'Returns: - False if OrigString is empty, else True.
Dim n As Integer
OrigStringWhichBecomesTheRemainder = Trim
(OrigStringWhichBecomesTheRemainder)
If OrigStringWhichBecomesTheRemainder <> "" Then
NextWord = True
If Delim = "" Then
Delim = " "
End If
n = XInStr(OrigStringWhichBecomesTheRemainder, Delim)
If n > 0 Then
ReturnedNextWord = Left(OrigStringWhichBecomesTheRemainder, n - 1)
OrigStringWhichBecomesTheRemainder = _
Trim(RightLess(OrigStringWhichBecomesTheRemainder, n + Len
(Delim) - 1))
Else
ReturnedNextWord = OrigStringWhichBecomesTheRemainder
OrigStringWhichBecomesTheRemainder = ""
End If
End If
End Function
Public Function ParseParamString(ByVal ParamString As String, ByRef
Result() As Variant) As Boolean
'Action: - Parse a formula, i.e. a string of form: aaa,bbb,ccc
' into: aaa, bbb, and ccc.
' - Leading '=' and outer ()'s must have been stripped first.
'Returns: True if ParamString contains an even number of left and
' right parens (or no parens). This result likely needs to
' be refined to return a false if other aspects of the
' param string syntax are hooey--say, embedded function
' names aren't nestled between a comma and paren.
'Note: - The challenge is with nesting, where you have something
' like:
' bbb(ccc(ddd,eee),fff),ggg(hhh,iii),jjj
' and you need to end up with:
' bbb(ccc(ddd,eee),fff) / ggg(hhh,iii) / jjj
Dim PosLastComma As Integer, Pos1stLeftParen As Integer, ResultIndex
As Integer
Dim Param As Variant, Temp() As Variant
Dim Remainder As String, PS As String
PS = ParamString
Do
'Does the string contain a left paren?
Pos1stLeftParen = XInStr(PS, "(")
Select Case Pos1stLeftParen
Case 0
'No left paren. But we may still have COMMA-demarcated params.
Call Arrayize(PS, ",", Temp)
Call AddMembers(Result, Temp)
ParseParamString = True
Exit Function
Case 1
'Trivial. Don't have time to code now.
Case Len(PS)
'Gibberish. Shouldn't happen.
Exit Function
End Select
'Paramstring now has a left paren.
'Now we need to look for any comma BEFORE that left paren. If we
'fine one, there're one or more intervening params we gotta parse
first.
'Now, this is mighty tricky: We must locate not the first, but the
'LAST comma before the left paren. Then, anything to the right of
'that comma is the function name that owns the paren.
PosLastComma = LastPosBefore(PS, ",", Pos1stLeftParen)
If PosLastComma > 0 Then
'At this point, any additional commas--prior to that last
'comma--are just gravy that this guy'll handle:
Call Arrayize(Left(PS, PosLastComma - 1), ",", Temp)
Call AddMembers(Result, Temp)
'Here's an easy step to forget. The paren logic following below
'wants the stuff up TO the comma stripped off
PS = RightLess(PS, PosLastComma)
'And an even EASIER step to forget. I certainly didn't catch it
'the first time. We must UPDATE the left paren's relative
position:
Pos1stLeftParen = XInStr(PS, "(")
End If
'Now find our corresponding right paren.
If Not FindBalancingRightParen(PS, Pos1stLeftParen, Remainder) Then
Exit Function
End If
'Flush.
ReDim Preserve Result(0 To ResultIndex)
Result(ResultIndex) = PS
IncI ResultIndex
'At this point, I believe the remainder can only be one of two
'things. Either it's empty ...:
If Remainder = "" Then
ParseParamString = True
Exit Function
End If
'... or it begin with a comma:
Call RemoveLeading(Remainder, ",")
PS = Remainder
Loop
End Function
Public Sub ReduceToParamString(ByRef Formula As String)
'Action: Given a string of either form '=xxx(yyy)' or 'xxx(yyy)',
return 'yyy'.
Call RemoveLeading(Formula, "=")
Call RemoveLeadingThru(Formula, "(")
Call RemoveEnding(Formula, ")")
End Sub
Public Function RemoveLeading(ByRef FromWhat As String, ByVal What As
String) As Boolean
'Action: If FromWhat begins with What, return FromWhat without it.
Dim LW As Integer
LW = Len(What)
If Left(FromWhat, LW) = What Then
FromWhat = RightLess(FromWhat, LW)
RemoveLeading = True
End If
End Function
Public Function RemoveLeadingThru(ByRef FromWhat As String, ByVal What
As String) As Boolean
'Action: If FromWhat contains substring What, remove everything
' from FromWhat thru What inclusive.
Dim n As Integer
n = XInStr(FromWhat, What)
If n > 0 Then
FromWhat = RightLess(FromWhat, n + Len(What) - 1)
RemoveLeadingThru = True
End If
End Function
Public Function RightLess(ByVal S As String, ByVal n As Integer) As
String
'Action: Chop n chars off the left of S.
Dim L As Integer
L = Len(S)
If n <= L Then
RightLess = Right(S, L - n)
Else
End If
End Function
Public Function XInStr(ByVal InWhat As String, _
ByVal What As String) As Integer
'Action: Return the position (if any) of What in InWhat,
' PERIOD. By 'PERIOD', I mean: if What is empty, False is returned.
'Note: - VBA's f-ing InStr() seems to return True if What is
' *empty*. That has burned us time and again.
If What <> "" Then
XInStr = InStr(InWhat, What)
End If
End Function
'<End of file>
http://groups.google.com/group/micr...read/thread/7316e138ece6d64e/b781ac69e8210f03
Here is code to parse a function's param string.
Namely, given a string of form "aaa,bbb,ccc", return an array
{"aaa","bbb","ccc"}.
Easy, yes, but given *this* string:
=x("abc",123,y(999,"xyz"),z(101,y(999,"xyz")))
return:
"abc"
123
y(999,"xyz")
z(101,y(999,"xyz"))
(However, this being the first time I've submitted anything this large
thru Google, much of the below, thanks to Google, is a complete
nightmare.
The Google input box is much tinier than the thread's posted screen;
worse it's in G.D. proportional font, and none of the CR/LFs are where
they should be.
If things really are unreadable, let me know and maybe I'll try to
clean up things more.)
***
This stuff is alpha, or even pre-alpha. It likely needs more testing.
OK, sports fans, here it is:
***
'Sample usage.
Dim VParams() As Variant
Call ReduceToParamString(Formula)
If Not ParseParamString(Formula, VParams) Then
MsgBox "Can't parse formula syntax."
End If
'The routines.
Public Sub AddMembers(ByRef ArrayToAddTo() As Variant, ByRef NewMembers
() As Variant)
'Action: Add everyone in param 2 to param 1.
'Note: I'm no VBA expert, so there may well way be a
'better way
' of doing this. For one thing, I just noticed I could
' ReDim array 1 just once, knowing the size of array 2.
Dim i As Long, L As Long
Dim Member As Variant
If HasMembers_V(ArrayToAddTo) Then
L = LBound(ArrayToAddTo)
i = UBound(ArrayToAddTo) + 1
End If
For Each Member In NewMembers
ReDim Preserve ArrayToAddTo(L To i)
ArrayToAddTo(i) = Member
i = i + 1
Next
End Sub
Public Function Arrayize(ByVal S As String, _
ByVal Delimiter As String, _
ByRef Arrray() As Variant) As Boolean
'Action: Given a string containing one or more occurrences of
' substring Delimiter, parse the intervening substrings into
' an array.
Dim i As Integer
Dim NW As String
While NextWord(S, NW, Delimiter)
ReDim Preserve Arrray(0 To i)
Arrray(i) = NW
Arrayize = True
i = i + 1
Wend
End Function
Private Function FindBalancingRightParen(ByRef S As String, ByVal
PosLeftParen As Integer, _
ByRef Remainder As String) As Boolean
'Action: We have been told that formula-like string S has a left
' paren. We are given the position of the FIRST left paren.
' Find its corresponding right paren. If found, return True,
' the balanced portion of S, and the remainder to the right
' of the balancing ')'.
'Note: I believe that, upon return, the caller should find our
' remainder to be one of only two things:
' - Empty.
' - Beginning with a comma.
Dim i As Integer, LenS As Integer, NumLeftParens As Integer,
NumRightParens As Integer
LenS = Len(S)
'Just for peace of mind:
If LenS > PosLeftParen + 1 Then
'We've been told there's a leading left paren, so this
'initialization is a no-brainer:
NumLeftParens = 1
For i = PosLeftParen + 1 To LenS
Select Case Mid(S, i, 1)
Case ")"
IncI NumRightParens
Case "("
IncI NumLeftParens
End Select
If NumRightParens = NumLeftParens Then
'We're there.
Remainder = Right(S, LenS - i)
'Since the input string contains the left paren, make sure
'the output string includes the right ditto.
S = Left(S, i)
FindBalancingRightParen = True
Exit Function
End If
Next
End If
End Function
Public Function HasMembers_V(ByRef Aray() As Variant) As Boolean
'Action: Return, simply, whether an array has any members.
'Notes: - Variant flavor. Use the _S version for strings.
' - Where's VBA on this? These constructions all seem to FAIL:
' - IsArray().
' - IsEmpty() returns f-ing FALSE if the array has no
' members. Huh??? What could possibly be "True" about an
' un-populated array?
' - IsNull() ditto.
' - LBound() & UBound() seem to throw an error too. Wouldn't
' you think setting UBound to, like, -1 when there's no
' members would be a good way to handle this condition? I
' mean, I've seen it occur. Am I thinking of another
' language?
On Error GoTo VBA_54_Where_Are_You
If LBound(Aray) > 0 Then
End If
HasMembers_V = True
Exit Function
VBA_54_Where_Are_You:
'"There's a holdup in the Bronx, Brooklyn's broken out in fights..."
End Function
Public Function LastPos(ByVal InWhat As String, _
ByVal OfWhat As String) As Integer
'Action: Return the position of the last occurrence, if any,
' of OfWhat in InWhat.
'Note: This needs to be rewritten to use InStrRev; would be
' much more efficient.
Dim i As Integer, L As Integer
If InWhat <> "" Then
L = Len(OfWhat)
For i = Len(InWhat) To 1 Step -1
If Mid(InWhat, i, L) = OfWhat Then
LastPos = i
Exit Function
End If
Next
End If
End Function
Public Function LastPosBefore(ByVal InWhat As String, ByVal OfWhat As
String, ByVal Before As Integer) As Integer
'Action: Return the position of the last OfWhat in InWhat before
' position Before.
LastPosBefore = LastPos(Left(InWhat, Before - 1), OfWhat)
End Function
Public Function NextWord(ByRef OrigStringWhichBecomesTheRemainder As
String, _
ByRef ReturnedNextWord As String, _
Optional ByVal Delim As String) As Boolean
'Action: Do the following:
' - Trim param 1.
' - If Param 1 contains a space, return the first word, set
' Param 1 to the right-hand remainder, and trim *it*.
' - If Param 1 contains no space, return all of Param 1 as
' the first word, and set Param 1 to empty string.
'Returns: - False if OrigString is empty, else True.
Dim n As Integer
OrigStringWhichBecomesTheRemainder = Trim
(OrigStringWhichBecomesTheRemainder)
If OrigStringWhichBecomesTheRemainder <> "" Then
NextWord = True
If Delim = "" Then
Delim = " "
End If
n = XInStr(OrigStringWhichBecomesTheRemainder, Delim)
If n > 0 Then
ReturnedNextWord = Left(OrigStringWhichBecomesTheRemainder, n - 1)
OrigStringWhichBecomesTheRemainder = _
Trim(RightLess(OrigStringWhichBecomesTheRemainder, n + Len
(Delim) - 1))
Else
ReturnedNextWord = OrigStringWhichBecomesTheRemainder
OrigStringWhichBecomesTheRemainder = ""
End If
End If
End Function
Public Function ParseParamString(ByVal ParamString As String, ByRef
Result() As Variant) As Boolean
'Action: - Parse a formula, i.e. a string of form: aaa,bbb,ccc
' into: aaa, bbb, and ccc.
' - Leading '=' and outer ()'s must have been stripped first.
'Returns: True if ParamString contains an even number of left and
' right parens (or no parens). This result likely needs to
' be refined to return a false if other aspects of the
' param string syntax are hooey--say, embedded function
' names aren't nestled between a comma and paren.
'Note: - The challenge is with nesting, where you have something
' like:
' bbb(ccc(ddd,eee),fff),ggg(hhh,iii),jjj
' and you need to end up with:
' bbb(ccc(ddd,eee),fff) / ggg(hhh,iii) / jjj
Dim PosLastComma As Integer, Pos1stLeftParen As Integer, ResultIndex
As Integer
Dim Param As Variant, Temp() As Variant
Dim Remainder As String, PS As String
PS = ParamString
Do
'Does the string contain a left paren?
Pos1stLeftParen = XInStr(PS, "(")
Select Case Pos1stLeftParen
Case 0
'No left paren. But we may still have COMMA-demarcated params.
Call Arrayize(PS, ",", Temp)
Call AddMembers(Result, Temp)
ParseParamString = True
Exit Function
Case 1
'Trivial. Don't have time to code now.
Case Len(PS)
'Gibberish. Shouldn't happen.
Exit Function
End Select
'Paramstring now has a left paren.
'Now we need to look for any comma BEFORE that left paren. If we
'fine one, there're one or more intervening params we gotta parse
first.
'Now, this is mighty tricky: We must locate not the first, but the
'LAST comma before the left paren. Then, anything to the right of
'that comma is the function name that owns the paren.
PosLastComma = LastPosBefore(PS, ",", Pos1stLeftParen)
If PosLastComma > 0 Then
'At this point, any additional commas--prior to that last
'comma--are just gravy that this guy'll handle:
Call Arrayize(Left(PS, PosLastComma - 1), ",", Temp)
Call AddMembers(Result, Temp)
'Here's an easy step to forget. The paren logic following below
'wants the stuff up TO the comma stripped off
PS = RightLess(PS, PosLastComma)
'And an even EASIER step to forget. I certainly didn't catch it
'the first time. We must UPDATE the left paren's relative
position:
Pos1stLeftParen = XInStr(PS, "(")
End If
'Now find our corresponding right paren.
If Not FindBalancingRightParen(PS, Pos1stLeftParen, Remainder) Then
Exit Function
End If
'Flush.
ReDim Preserve Result(0 To ResultIndex)
Result(ResultIndex) = PS
IncI ResultIndex
'At this point, I believe the remainder can only be one of two
'things. Either it's empty ...:
If Remainder = "" Then
ParseParamString = True
Exit Function
End If
'... or it begin with a comma:
Call RemoveLeading(Remainder, ",")
PS = Remainder
Loop
End Function
Public Sub ReduceToParamString(ByRef Formula As String)
'Action: Given a string of either form '=xxx(yyy)' or 'xxx(yyy)',
return 'yyy'.
Call RemoveLeading(Formula, "=")
Call RemoveLeadingThru(Formula, "(")
Call RemoveEnding(Formula, ")")
End Sub
Public Function RemoveLeading(ByRef FromWhat As String, ByVal What As
String) As Boolean
'Action: If FromWhat begins with What, return FromWhat without it.
Dim LW As Integer
LW = Len(What)
If Left(FromWhat, LW) = What Then
FromWhat = RightLess(FromWhat, LW)
RemoveLeading = True
End If
End Function
Public Function RemoveLeadingThru(ByRef FromWhat As String, ByVal What
As String) As Boolean
'Action: If FromWhat contains substring What, remove everything
' from FromWhat thru What inclusive.
Dim n As Integer
n = XInStr(FromWhat, What)
If n > 0 Then
FromWhat = RightLess(FromWhat, n + Len(What) - 1)
RemoveLeadingThru = True
End If
End Function
Public Function RightLess(ByVal S As String, ByVal n As Integer) As
String
'Action: Chop n chars off the left of S.
Dim L As Integer
L = Len(S)
If n <= L Then
RightLess = Right(S, L - n)
Else
End If
End Function
Public Function XInStr(ByVal InWhat As String, _
ByVal What As String) As Integer
'Action: Return the position (if any) of What in InWhat,
' PERIOD. By 'PERIOD', I mean: if What is empty, False is returned.
'Note: - VBA's f-ing InStr() seems to return True if What is
' *empty*. That has burned us time and again.
If What <> "" Then
XInStr = InStr(InWhat, What)
End If
End Function
'<End of file>