Fonction avancees de recherche et d'extraction de texte.

Télécharger le projet
Commenter

Description

Description _________________
Ce module vous fournit des fonctions avancees de recherche et de remplacement de chaines de caracteres.
Aucune pretention, j'ai ecrit ces fonctions pour les avoir sous la main dans un module.

Fonctionnement ______________
Toutes les fonctions sont basees sur des fonctions natives de Visual Basic tout en les ameliorant.
Pour des raisons de continuite, les parametres des fonctions avancees respectent le plus fidelement possible ceux des fonctions standards.
Pour les fonctions de recherche, le parametre recherche est remplace par un tableau de parametres.
Pour les fonctions d'extraction, les parametres sont ameliores de telle sorte a accepter des valeurs negatives.

Exemple _________________
Dim Value
Value = NbStrInStr("We're in the pipe five by five", "e ")
Debug.Print Value
Value = InStrFirst("$23,740.56", Array("$", ",", "."))
Debug.Print Value
Value = InStrRevFirst("$23,740.56", Array("$", ",", "."), 7)
Debug.Print Value
Value = LeftPlus("Somebody called for an exterminator?", -14)
Debug.Print """" & Value & """"
Value = MidPlus("Input coordinates.", -12)
Debug.Print """" & Value & """"
Value = MidPlus("Insufficient Vespen gas.", 14, -5)
Debug.Print """" & Value & """"

+--------------------------------+
| 4 |
| 1 |
| 4 |
|"Somebody called for an" |
|"coordinates." |
|"Vespen" |
+--------------------------------+

Source / Exemple : 


'************************************************************************'
'************************************************************************'
'**                                                                    **'
'**                 ADVANCED STRING OPERATIONS MODULE                  **'
'**                                                                    **'
'************************************************************************'
'************************************************************************'

'----------------------------   ATTRIBUTES   ----------------------------'
'Author = Santiago Diez (santiago.diez@free.fr)
'Website = http://santiago.diez.free.fr
'Webpage = http://www.vbfrance.com/code.aspx?ID=38474
'Date = 2006 JULY 26  10:11
'Version = 2.1

'----------------------------   COPYRIGHT   -----------------------------'
'I worked on  that module for  me and for  you. You are  allowed to do the
'following  as long  as you  specify my  name and  website  (please  don't
'laught, one day it will be a real website):
'- use the code, partially or totally
'- change the code partially
'If you ever improve the features of  that module, fix any bug or find any
'way to make it better, please write to me for feedback.

'---------------------------   DESCRIPTION   ----------------------------'
'This module  provides you with powerfull  functions to read,  replace and
'find string values.

'---------------------------   HOW IT WORKS   ---------------------------'
'Every  function  is based  on  and  improve  native Visual  Basic  string
'functions. The  parameters of  the advanced functions  stick as  close as
'possible to those of the standard function.

'-----------------   PUBLIC PROCEDURES AND FUNCTIONS   ------------------'
'Long = NbStrInStr(Expression As String, Find As String, [Compare As
'                  VbCompareMethod = vbBinaryCompare])
'Long = InStrFirst([Start], [String1], [ArrayOfString2], [Compare As
'                  VbCompareMethod = vbBinaryCompare])
'Long = InStrRevFirst(StringCheck As String, ArrayOfStringMatch, [Start As
'                     Long = -1], [Compare As VbCompareMethod =
'                     vbBinaryCompare])

'Variant = LeftPlus(myString, [Length])
'Variant = MidPlus(myString, Start As Long, [Length])
'String = MidBetween(Expression As String, LeftDelim As String, RightDelim
'                    As String, [Start], [Options As MidBetweenOptions],
'                    [Compare As VbCompareMethod = vbBinaryCompare])

'Variant = SplitPlus(Expression As String, [Delimiter], [Limit As Long =
'                    -1], [Compare As VbCompareMethod = vbBinaryCompare])
'String = JoinPlus(SourceArray, [Delimiter], [Start], [Count])

'String = RevString(myString As String)

'-----------------------------   EXAMPLES   -----------------------------'
'   Dim Value
'   Value = NbStrInStr("We're in the pipe five by five", "e ")
'   Debug.Print Value
'   Value = InStrFirst("$23,740.56", Array("$", ",", "."))
'   Debug.Print Value
'   Value = InStrRevFirst("$23,740.56", Array("$", ",", "."), 7)
'   Debug.Print Value
'   Value = LeftPlus("Somebody called for an exterminator?", -14)
'   Debug.Print """" & Value & """"
'   Value = MidPlus("Input coordinates.", -12)
'   Debug.Print """" & Value & """"
'   Value = MidPlus("Insufficient Vespen gas.", 14, -5)
'   Debug.Print """" & Value & """"

'       +--------------------------------+
'       | 4                              |
'       | 1                              |
'       | 4                              |
'       |"Somebody called for an"        |
'       |"coordinates."                  |
'       |"Vespen"                        |
'       +--------------------------------+

'-------------------------------   BUGS   -------------------------------'
'No bug reported.

'-----------------------------   SOURCES   ------------------------------'
'Jean-Marc (http://www.vbfrance.com/auteurdetail.aspx?ID=205448):
'   - Optimization
'Asimiengo (http://www.vbfrance.com/auteurdetail.aspx?ID=476539):
'   - Original idea for function "MidBetween"

'------------------------   REQUIRED LIBRARIES   ------------------------'
'msvbvm60.dll, VB6.OLB, VB6FR.DLL (Always required)

'--------------------   REQUIRED MODULES AND FORMS   --------------------'
'None

'-----------------------------   OPTIONS   ------------------------------'
Option Base 0
Option Compare Text
Option Explicit

'+----------------------------------------------------------------------+'
'+                           TYPES AND ENUMS                            +'
'+----------------------------------------------------------------------+'
'Enum: MidBetweenOptions
'   Enumeration of the options for function MidBetween().
'------------------------------------------------------------------------'
Enum MidBetweenOptions
    mbStrictlyBetween = &H1
    mbFromTheEnd = &H2
End Enum

'+----------------------------------------------------------------------+'
'+                                 FIND                                 +'
'+----------------------------------------------------------------------+'
'Function: NbStrInStr
'   Returns the number of occurence of a substring in an expression.
'   Parameters: Expression:  A String expression containing  the substring
'                   to find.
'               Find:  A string  expression  specifying  the substring  to
'                   search for.
'               Compare (Optional): A numeric value indicating the kind of
'                   comparison to use when evaluating substrings.
'------------------------------------------------------------------------'
Function NbStrInStr(Expression As String, Find As String, Optional _
Compare As VbCompareMethod = vbBinaryCompare) As Long
    If Find <> "" _
    Then NbStrInStr = (Len(Expression) - Len(Replace(Expression, _
                      Find, "", , , Compare))) / Len(Find)
End Function

'------------------------------------------------------------------------'
'Function: InStrFirst
'   Returns  a  Variant  (Long)  specifying  the  position  of  the  first
'   occurrence of one or more strings within another.
'   Parameters: Start (Optional):   Numeric  expression   that  sets   the
'                   starting position for each  search. If omitted, search
'                   begins  at the  first character  position. If  "Start"
'                   contains "Null", an error occurs. The "Start" argument
'                   is required if "Compare" is specified.
'               String1: String expression being searched.
'               ArrayOfString2: An array of string expression sought.
'               Compare (Optional):   Specifies   the   type   of   string
'                   comparison. If  "Compare" is "Null", an  error occurs.
'                   If "Compare" is omitted,  the "Option Compare" setting
'                   determines  the type  of comparison.  Specify a  valid
'                   LCID (LocaleID)  to use  locale-specific rules  in the
'                   comparison.
'------------------------------------------------------------------------'
Function InStrFirst(Optional Start, Optional String1, Optional _
ArrayOfString2, Optional Compare As VbCompareMethod = vbBinaryCompare)
    Dim i As Long
    Dim Pos
    'Rearrange parameters to make this function similar to "Instr"
    If IsMissing(String1) Then GoTo Err_Arg
    If IsMissing(ArrayOfString2) Then
        If IsMissing(Start) Then GoTo Err_Arg
        ArrayOfString2 = String1
        String1 = Start
        Start = 1
    End If
    'If ArrayOfString2 is an array...
    If IsArray(ArrayOfString2) Then
        'Seek items calling "InStrFirst" recursively
        For i = LBound(ArrayOfString2) To UBound(ArrayOfString2)
            Pos = InStrFirst(Start, String1, ArrayOfString2(i), Compare)
            'Return the first item found.
            If IsEmpty(InStrFirst) Or IsNull(InStrFirst) Then
                InStrFirst = Pos
            ElseIf Not IsNull(Pos) And Pos > 0 Then
                If InStrFirst < 1 Or Pos < InStrFirst _
                Then InStrFirst = Pos
            End If
        Next
    'If ArrayOfString2 is not an array, return InStr() answer
    Else
        InStrFirst = InStr(Start, String1, ArrayOfString2, Compare)
    End If
Exit Function
Err_Arg:
    Err.Raise 13    'Type mismatch
End Function

'------------------------------------------------------------------------'
'Function: InStrRevFirst
'   Returns the  position of an occurrence  of one or more  strings within
'   another, from the end of string.
'   Parameters: StringCheck: String expression being searched.
'               ArrayOfStringMatch: An  array of  string expression  being
'                   searched for.
'               Start (Optional):   Numeric  expression   that  sets   the
'                   starting position for  each search. If omitted,  -1 is
'                   used, which means  that the search begins  at the last
'                   character  position. If  "Start"  contains "Null",  an
'                   error occurs.
'               Compare (Optional):  Numeric value indicating the  kind of
'                   comparison  to  use  when  evaluating  substrings.  If
'                   omitted, a binary comparison is performed.
'------------------------------------------------------------------------'
Function InStrRevFirst(StringCheck As String, ArrayOfStringMatch, _
Optional Start As Long = -1, Optional Compare As VbCompareMethod = _
vbBinaryCompare) As Long
    Dim i As Long
    Dim Pos
    'If ArrayOfStringMatch is an array...
    If IsArray(ArrayOfStringMatch) Then
        'Seek items calling "InStrRevFirst" recursively
        For i = LBound(ArrayOfStringMatch) To UBound(ArrayOfStringMatch)
            Pos = InStrRevFirst(StringCheck, ArrayOfStringMatch(i), _
                                Start, Compare)
            'Return the first item found.
            If IsEmpty(InStrRevFirst) Or IsNull(InStrRevFirst) Then
                InStrRevFirst = Pos
            ElseIf Not IsNull(Pos) And Pos > InStrRevFirst Then
                InStrRevFirst = Pos
            End If
        Next
    'If ArrayOfStringMatch is not an array, return InStrRev() answer
    Else
        InStrRevFirst = InStrRev(StringCheck, ArrayOfStringMatch, _
                                 Start, Compare)
    End If
End Function

'+----------------------------------------------------------------------+'
'+                               EXTRACT                                +'
'+----------------------------------------------------------------------+'
'Function: LeftPlus
'   Returns a Variant (String) containing a specified number of characters
'   from the left side of a string.
'   Parameters: myString:  String  expression  from which  the  left  most
'                   characters are returned. If  "String" contains "Null",
'                   "Null" is returned.
'               Length (Optional):  Variant   (Long).  Numeric  expression
'                   indicating  how many  characters to  return.  If 0,  a
'                   zero-length string  ("") is returned. If  greater than
'                   or equal to the number  of characters in "String", the
'                   entire  string  is  returned.  If  less  than  0,  all
'                   characters  are returned  but  the  "Length" last.  If
'                   omitted, the first character in "String" is returned.
'------------------------------------------------------------------------'
Function LeftPlus(myString, Optional Length)
    If IsMissing(Length) Then
        LeftPlus = Left(myString, 1)
    ElseIf Length < 0 Then
        LeftPlus = Left(myString, Len(myString) + Length)
    Else
        LeftPlus = Left(myString, Length)
    End If
End Function

'------------------------------------------------------------------------'
'Function: MidPlus
'   Returns a Variant (String) containing a specified number of characters
'   from a string.
'   Parameters: myString:  String  expression from  which  characters  are
'                   returned.  If  "String"  contains  "Null",  "Null"  is
'                   returned.
'               Start: Long. Character  position in "String" at  which the
'                   part to  be taken begins.  If "Start" is  greater than
'                   the  number  of   characters  in  "String",  "MidPlus"
'                   returns a  zero-length string  (""). If  less than  or
'                   equal  to  0,  start position  is  "Start"  characters
'                   before the end of "String".
'               Length (Optional): Variant (Long). Number of characters to
'                   return. If omitted or if there are fewer than "Length"
'                   characters  in the  text (including  the character  at
'                   "Start"), all characters from  the "Start" position to
'                   the end  of the string are  returned. If less  than or
'                   equal to 0,  all characters from the  "Start" position
'                   to "Length" before the end of the string are returned.
'------------------------------------------------------------------------'
Function MidPlus(myString, Start As Long, Optional Length)
    If IsMissing(Length) Then
        If Start > 0 _
        Then MidPlus = Mid(myString, Start) _
        Else MidPlus = Mid(myString, Len(myString) + Start + 1)
    ElseIf Length < 0 Then
        If Start > 0 _
        Then MidPlus = Mid(myString, Start, _
                                     Len(myString) + Length - Start + 1) _
        Else MidPlus = Mid(myString, Len(myString) + Start + 1, _
                                     Length - Start)
    Else
        If Start > 0 _
        Then MidPlus = Mid(myString, Start, Length) _
        Else MidPlus = Mid(myString, Len(myString) + Start + 1, Length)
    End If
End Function

'------------------------------------------------------------------------'
'Function: MidBetween
'   Returns a  string containing  all characters  from a  string contained
'   between two specified delimiters.
'   Parameters: Expression:  String expression  from which  characters are
'                   returned.
'               LeftDelim: String expression specifying the substring used
'                   as  left delimiter  for the  substring  to return.  If
'                   "LeftDelim" is a  zero-length string ("") or  if it is
'                   not found,  the string  returned starts  to the  first
'                   character of "Expression".
'               RightDelim:  String  expression specifying  the  substring
'                   used as right  delimiter for the substring  to return.
'                   If "RightDelim" is a zero-length  string ("") or if it
'                   is not found, "MidBetween" returns all characters from
'                   "LeftDelim" up to the last character of "Expression".
'               Start (Optional):   Position  within   "Expression"  where
'                   delimiters search is to begin. If "Start" is less than
'                   0, search  begins minus "Start" characters  before the
'                   end of "Expression" string. If omitted, 1 is assumed.
'               Options (Optional): Numeric expression that  is the sum of
'                   values  specifying the  way  substring delimiters  are
'                   searched. Use the following constants:
'                   mbFromTheEnd: Specify that the delimiters are searched
'                       starting from  the end of "Expression"  string. If
'                       "Start"  is  specified, substring  delimiters  are
'                       searched from  "Start" position  and backward.  If
'                       "Start"  is  omitted,  -1 is  assumed.  The  first
'                       delimiter searched is "RightDelim".
'                   mbStrictlyBetween: Specify that the substring returned
'                       should  not  contain any  delimiter.  "MidBetween"
'                       returns  the  first  substring  that  is  strictly
'                       contained  between a  left delimiter  and a  right
'                       delimiter. If "mbFromTheEnd" is set, the substring
'                       returned is  the last  that is  strictly contained
'                       between a left delimiter and a right delimiter. If
'                       one of the delimiters is  not found, a zero-length
'                       string ("") is returned.
'               Compare (Optional):  Numeric value indicating the  kind of
'                   comparison  to  use  when  evaluating  substrings.  If
'                   omitted,  a binary  comparison is  performed. Use  the
'                   following constants:
'                   vbUseCompareOption:  Performs a  comparison using  the
'                       setting of the Option Compare statement.
'                   vbBinaryCompare: Performs a binary comparison.
'                   vbTextCompare: Performs a textual comparison.
'                   vbDatabaseCompare: Microsoft  Access only.  Performs a
'                       comparison based on information in your database.
'   Examples: MidBetween("(A * (B - C))", "(", ")")
'                 returns "A * (B - C"
'             MidBetween("(A * (B - C))", "(", ")", , mbStrictlyBetween)
'                 returns "B - C"
'             MidBetween("(A * (B - C))", "(", ")", , mbFromTheEnd)
'                 returns "B - C)"
'------------------------------------------------------------------------'
Function MidBetween(ByVal Expression As String, ByVal LeftDelim As _
String, ByVal RightDelim As String, Optional ByVal Start, Optional _
Options As MidBetweenOptions, Optional Compare As VbCompareMethod = _
vbBinaryCompare) As String
    Dim i As Long
    Dim Arr() As String
    Dim Arr2() As String
    Dim Temp As String
    Dim Flag As Boolean
    'Delimiters cannot be Null
    If IsNull(LeftDelim) Or IsNull(RightDelim) _
    Then Err.Raise 94
    'If "Expression" is null or is a zero-length string ("")
    If IsNull(Expression) Or Expression = "" Then
        MidBetween = Expression
    Else
        'If mbFromTheEnd is set...
        If Options And mbFromTheEnd Then
            'Reverse "Expression"
            Expression = RevString(Expression)
            'Switch delimiters
            Temp = LeftDelim
            LeftDelim = RightDelim
            RightDelim = Temp
            'Reverse "Start"
            If Not IsMissing(Start) _
            Then Start = -Start
        End If
        'If start is specified, trim "Expression"
        If Not IsMissing(Start) _
        Then Expression = MidPlus(Expression, CLng(Start))
        'Case returned value is strictly between delimiters
        If Options And mbStrictlyBetween Then
            Select Case (RightDelim = "") + 2 * (LeftDelim = "")
                Case 0  'No delimiter is a zero-length strings ("")
                    'Split "Expression" with "LeftDelim"
                    Arr = Split(Expression, LeftDelim, , Compare)
                    'Search for the first item with "RightDelim"
                    Do While Not Flag And i < UBound(Arr)
                        i = i + 1
                        Arr2 = SplitPlus(Arr(i), RightDelim, , Compare)
                        If UBound(Arr2) > 0 Then
                            MidBetween = Arr2(0)
                            Flag = True
                        End If
                    Loop
                Case -1 'Only right delimiter is a zero-length string ("")
                    'Split with "LeftDelim" and return last item
                    Arr = Split(Expression, LeftDelim, , Compare)
                    If UBound(Arr) > 0 Then MidBetween = Arr(UBound(Arr))
                Case -2 'Only left delimiter is a zero-length string ("")
                    'Split with "RightDelim" and return first item
                    Arr = Split(Expression, RightDelim, , Compare)
                    If UBound(Arr) > 0 Then MidBetween = Arr(0)
                Case -3 'Both delimiters are zero-length strings ("")
                    MidBetween = Expression
            End Select
        'Case returned value is not strictly between delimiters
        Else
            'Split "Expression" in two parts with "LeftDelim"
            Arr = SplitPlus(Expression, LeftDelim, 2, Compare)
            'Get last part
            MidBetween = Arr(UBound(Arr))
            'Split right part with "RightDelim" and get first part
            MidBetween = SplitPlus(MidBetween, RightDelim, , Compare)(0)
        End If
        'If mbFromTheEnd is set, reverse returned value
        If Options And mbFromTheEnd _
        Then MidBetween = RevString(MidBetween)
    End If
End Function

'+----------------------------------------------------------------------+'
'+                                SPLIT                                 +'
'+----------------------------------------------------------------------+'
'Function: SplitPlus
'   Returns  a zero-based,  one-dimensional array  containing a  specified
'   number of substrings.
'   Parameters: Expression:  String expression  containing substrings  and
'                   delimiters. If  "Expression" is  a zero-length  string
'                   (""),   "Split"   returns   a   single-element   array
'                   containing a zero-length string ("").
'               Delimiter (Optional):  String expression used  to identify
'                   substring  limits.  If omitted,  the  space  character
'                   (" ") is assumed  to be the delimiter.  If "Delimiter"
'                   is a  zero-length string (""), a  single-element array
'                   containing the entire "Expression" string is returned.
'                   If "Delimiter" is Null, an array in which each item is
'                   a single character from "Expression" is returned.
'               Limit (Optional): Number of substrings  to be returned; ?1
'                   indicates that all substrings are returned.
'               Compare (Optional):  Numeric value indicating the  kind of
'                   comparison to use when  evaluating substrings. Use the
'                   following constants:
'                   vbUseCompareOption:  Performs a  comparison using  the
'                       setting of the Option Compare statement.
'                   vbBinaryCompare: Performs a binary comparison.
'                   vbTextCompare: Performs a textual comparison.
'                   vbDatabaseCompare: Microsoft  Access only.  Performs a
'                       comparison based on information in your database.
'------------------------------------------------------------------------'
Function SplitPlus(Expression As String, Optional Delimiter, Optional _
Limit As Long = -1, Optional Compare As VbCompareMethod = vbBinaryCompare)
    Dim i As Long
    Dim strArray() As String
    'If "Expression" is a zero-length string ("")
    If Expression = "" Then
        SplitPlus = Split("", "", Limit)
    'If "Delimiter" is omitted
    ElseIf IsMissing(Delimiter) Then
        SplitPlus = Split(Expression, Delimiter, Limit, Compare)
    'If "Delimiter" is Null
    ElseIf IsNull(Delimiter) Then
        ReDim strArray(Len(Expression) - 1)
        For i = 1 To Len(Expression)
            strArray(i - 1) = Mid$(Expression, i, 1)
        Next
        SplitPlus = strArray
    'General case
    Else
        SplitPlus = Split(Expression, Delimiter, Limit, Compare)
    End If
End Function

'------------------------------------------------------------------------'
'Function: JoinPlus
'   Returns a string  created by joining a specified  number of substrings
'   contained in an array.
'   Parameters: SourceArray:  One-dimensional array  containing substrings
'                   to be joined.
'               Delimiter:   String  character   used   to  separate   the
'                   substrings  in the  returned string.  If omitted,  the
'                   space  character (" ")  is  used.  If delimiter  is  a
'                   zero-length string  (""), all  items in  the list  are
'                   concatenated with no delimiters.
'               Start: A numeric expression specifying the position of the
'                   first  item in  the  list to  be  joined. If  omitted,
'                   "JoinPlus" joins  strings from the  first item  in the
'                   list.
'               Count:  A  numeric  expression specifying  the  number  of
'                   string items  to join after  "Start". If  omitted, all
'                   items in the list after "Start" are joined.
'------------------------------------------------------------------------'
Function JoinPlus(SourceArray, Optional Delimiter, Optional Start, _
Optional Count) As String
    Dim i As Long
    Dim SourceArrayPlus
    Dim LBoundPlus As Long, UBoundPlus As Long
    'If "Start" is omitted, join from first item
    If IsMissing(Start) Then
        LBoundPlus = LBound(SourceArray)
    Else
        LBoundPlus = Start
    End If
    'If "Count" is omitted, join until last item
    If IsMissing(Count) Then
        UBoundPlus = UBound(SourceArray)
    Else
        'If "Count" counts more item than existing, join until last item
        If LBoundPlus + Count > UBound(SourceArray) Then
            UBoundPlus = UBound(SourceArray)
        Else
            UBoundPlus = LBoundPlus + Count - 1
        End If
    End If
    'If new lower bound is equal to previous lower bound...
    If LBoundPlus = LBound(SourceArray) Then
        'Retireve entiere array...
        SourceArrayPlus = SourceArray
        'Redim only upper bound
        If UBoundPlus < UBound(SourceArray) Then
            ReDim Preserve SourceArrayPlus(LBoundPlus To UBoundPlus)
        End If
    'If new lower bound is greater than previous lower bound...
    Else
        'Dim new array and set items one by one
        ReDim SourceArrayPlus(LBoundPlus To UBoundPlus)
        For i = LBoundPlus To UBoundPlus
            SourceArrayPlus(i) = SourceArray(i)
        Next
    End If
    'Return value
    JoinPlus = Join(SourceArrayPlus, Delimiter)
End Function

'+----------------------------------------------------------------------+'
'+                            SPLIT BRACKETS                            +'
'+----------------------------------------------------------------------+'
'------------------------------------------------------------------------'
Function SplitBrackets(Expression As String, LeftDelim As String, _
RightDelim As String, Optional Options As MidBetweenOptions) As String
    Dim NbLeft As Long, NbRight As Long
    Dim ArrOpen() As String, ArrClose() As String
    Dim mbBracketMode
    '"Expression" cannot be a zero-length string ("")
    If Expression <> "" Then
        'If bracket mode is not required
        If Not CBool(Options And mbBracketMode) Then
            'Split "Expression" with "LeftDelim"
            ArrOpen = Split(Expression, LeftDelim, 2)
            'Return right part or whole part if:
            '- "LeftDelim" is a zero-length string ("")
            '- "LeftDelim" is not found
            SplitBrackets = ArrOpen(UBound(ArrOpen))
            'Split "Expression" with "RightDelim"
            'and return middle part or whole part if:
            '- "RightDelim" is a zero-length string ("")
            '- "RightDelim" is not found
            If SplitBrackets <> "" _
            Then SplitBrackets = Split(SplitBrackets, RightDelim)(0)
        'In bracket mode, delimiters cannot be zero-length strings ("")
        ElseIf LeftDelim <> "" And RightDelim <> "" Then
            'Split "Expression" with "LeftDelim"
            ArrOpen = Split(Expression, LeftDelim)
            'Split each part with "RightDelim"
            'and retrieve correponding bracket
            NbLeft = 1
            Do While NbRight < NbLeft And NbLeft <= UBound(ArrOpen)
                ArrClose = SplitPlus(ArrOpen(NbLeft), RightDelim)
                NbRight = NbRight + UBound(ArrClose)
                'There must be at least one closing bracket
                If UBound(ArrClose) > 0 Then
                    'If there is only one pair of bracket
                    If NbLeft = 1 Or NbRight = 1 Then
                        If SplitBrackets = "" _
                        Then SplitBrackets = ArrClose(0)
                    'If there is more than one pair of brackets
                    Else
                        'If there is not enough closing brackets
                        If NbRight < NbLeft Then
                            SplitBrackets = JoinPlus(ArrOpen, LeftDelim, _
                                                  NbLeft - NbRight + 1, _
                                                  NbRight - 1) _
                                       & LeftDelim _
                                       & JoinPlus(ArrClose, RightDelim, _
                                                  0, UBound(ArrClose))
                        'If there is enough or too much closing brackets
                        Else
                            SplitBrackets = JoinPlus(ArrOpen, LeftDelim, 1, _
                                                  NbLeft - 1) _
                                       & LeftDelim _
                                       & JoinPlus(ArrClose, RightDelim, _
                                                  0, NbLeft - NbRight _
                                                   + UBound(ArrClose))
                        End If
                    End If
                End If
                If NbRight < NbLeft Then NbLeft = NbLeft + 1
            Loop
        Else
        End If
    End If
End Function

'+----------------------------------------------------------------------+'
'+                              PALINDROME                              +'
'+----------------------------------------------------------------------+'
'Function: RevString
'   Returns  a string  in  wich  the order  of  the  characters have  been
'   reversed.
'   Parameters: myString:  String expression  containing he  characters to
'                   reverse.
'------------------------------------------------------------------------'
Function RevString(myString As String) As String
    Dim i As Long
    'Pre-range answer
    RevString = Space$(Len(myString))
    'Set characters one by one
    For i = 1 To Len(myString)
        Mid$(RevString, i, 1) = Mid$(myString, Len(myString) - i + 1, 1)
    Next
End Function

Conclusion :


Je poste ce module pour eviter quelques lignes de codes a certains. Inutile de preciser qu'il est trivial, je l'assume. Je ne le poste pas pour la qualite du code mais pour toute la reflexion que j'ai apportee au choix des parametres. Ca vous sert tant mieux, moi ca me sert de temps en temps, au moins c'est ecrit quelquepart.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_santiago69)