Hi Luis,
For your first question, it looks as if you need to find the quantity
that appears before a particular price somewhere in the string. That's a
job that regular expression engines do very well. Here's a little
function that seems to do what you ask:
Function ChangeQuantity(S As Variant, _
Price As String, DeltaQuantity As Long) As Variant
'Takes a string that may contain one or more patterns like this
' Quantity X Price
' e.g
' 100 X $40
' locates the quantity associated with the specified price,
' adds DeltaQuantity to it,
' and returns the modified string.
Dim oRE As Object 'VBScript_RegExp_55.RegExp
Dim oMatches As Object 'VBScript_RegExp_55.MatchCollection
Dim lngQuantity As Long
If IsNull(S) Then
ChangeQuantity = Null
Else
Set oRE = CreateObject("VBScript.RegExp")
With oRE
.Global = False
.IgnoreCase = True
.Multiline = True
.Pattern = "^(.*\s)(\d+)(\sX\s\" & Price & ".*)$"
' ^ anchors the pattern to the start of the string
' (.*\s) matches the first part of the string (first submatch)
' (\d+) matches the digits of the quantity
' \sX\s matches the " X " before the price
' .* matches the remainder of the string
' $ anchors to end of string
Set oMatches = .Execute(CStr(S))
If oMatches.Count > 0 Then
lngQuantity = CLng(oMatches(0).SubMatches(1))
lngQuantity = lngQuantity + DeltaQuantity
With oMatches(0).SubMatches
ChangeQuantity = .Item(0) _
& Format(lngQuantity, "#,##0") & .Item(2)
End With
Else 'No match found
ChangeQuantity = S
End If
End With
End If
Set oMatches = Nothing
Set oRE = Nothing
End Function
For more on regular expressions, see VBScript help and
http://dmoz.org/Computers/Programming/Languages/Regular_Expressions/
Hello.
I have a field with a string that i need to work. The string has the
following form:
QT1 X Amount1 + QT2 X Amount2 + ......
What i'd like to do is to alter the quantity of a certain item acording to
the amount payed. The amount payed for a certain item may vary. For instance,
if i have 20 units bought at 100$ and 30 units bought at 150$. Now i want to
order more units of that item but now the price is 100$ again. What i want is
to alter the quantity bought at 100$ in the string. Can anyone help me?
Another question is the use of INSTR. I use the INSTR function to get the
position of a certain character on a certain string. Now what i'd like to
know is if its possible to go through the string, character by character,
from the position retrieved by INSTR to the begining of the string. in
another words, moving backwards.
'START OF CODE
Function rgxReplace(Optional Target As Variant, _
Optional Pattern As String = "", _
Optional Replacement As String = "", _
Optional CaseSensitive As Boolean = False, _
Optional ReplaceAll As Boolean = True, _
Optional Multiline As Boolean = False, _
Optional FailOnError As Boolean = True, _
Optional Persist As Boolean = True) _
As Variant
'Regular expression replacement function suitable for use
'in VBA generally and in Access queries.
'Takes a search string (Target), a regular expression
'(Pattern), and a replacement string (Replacement).
'If a substring of Target matches Pattern, that substring
'is replaced by Replacement. (The substring can be the whole
'of Target.)
'CaseSensitive matches regardless of case
'but does not affect the case of Replacement.
'ReplaceAll controls whether all substrings
'that match Pattern are replaced or only the first.
'Multiline controls whether a Target containing
'newlines is parsed as one multiline string or a
'succession of one-line strings.
'Persist controls whether the compiled RegExp object
'remains in memory ready for the next call to the
'function or whether it is disposed of immediately. This
'means the function can be used in queries without having
'to create, compile, use and destroy
'a new RegExp object for each row being processed.
'But it also means that the object remains in memory
'after the query has run. To destroy the object and release
'the memory, call this function one last time with no arguments.
'
'Calling the function with different arguments (e.g. a new
'Pattern and/or Replacement) recompiles the RegExp object, so
'the function can be used in different queries. However there
'may be problems if two threads are calling the function at
'the same time.
Const rgxPROC_NAME = "rgxReplace"
Static oRE As Object
'Static declaration means we don't have to create
'and compile the RegExp object every time the function
'is called.
On Error GoTo ErrHandler
rgxReplace = Null 'Default return value
'NB: if FailOnError is false, returns Null on error
If IsMissing(Target) Then
'This is the signal to dispose of oRE
Set oRE = Nothing
Exit Function 'with default value
End If
'Create the RegExp object if necessary
If oRE Is Nothing Then
Set oRE = CreateObject("VBScript.Regexp")
End If
With oRE
'Check whether the current arguments (other than Target)
'are different from those stored in oRE, and update them
'(thereby recompiling the regex) only if necessary.
If CaseSensitive = .IgnoreCase Then
.IgnoreCase = Not .IgnoreCase
End If
If ReplaceAll <> .Global Then
.Global = ReplaceAll
End If
If Multiline <> .Multiline Then
.Multiline = Multiline
End If
If Pattern <> .Pattern Then
.Pattern = Pattern
End If
'Finally, do the replacement
If IsNull(Target) Then
rgxReplace = Null
Else
rgxReplace = .Replace(CStr(Target), Replacement)
End If
End With
'Tidy up and normal exit
If Not Persist Then Set oRE = Nothing
Exit Function
ErrHandler:
If FailOnError Then
With Err
Select Case .Number
'Replace the default "object-defined error" message
Case 13: .Description = "Type mismatch, probably because " _
& "the ""Target"" argument could not be converted to a string"
Case 5017: .Description = "Syntax error in regular expression"
Case 5018: .Description = "Unexpected quantifier in regular
expression"
Case 5019: .Description = "Expected ']' in regular expression"
Case 5020: .Description = "Expected ')' in regular expression"
Case Else
If oRE Is Nothing Then 'Failed to create Regexp object
.Description = "Could not create VBScript.RegExp object. " &
Err.Description
Else 'Unexpected error
.Description = rgxPROC_NAME & ": " & .Description
End If
End Select
Set oRE = Nothing
.Raise Err.Number, rgxPROC_NAME, _
rgxPROC_NAME & "(): " & .Description
End With
Else 'Fail silently
Err.Clear
Set oRE = Nothing
End If
End Function
'END OF CODE
