Problem with a loop

[Magic_Doctor]

This function is used to extract, from a chain where are distributed telephone numbers, a number following its position in the chain.
Chain example:
"Pitaluga has several telephone numbers: 06 66 99 55 78 & 294 54 20 44 & 099 925 301 & 06 300 200 11 & 095 233 144 & 600 25 52 30"
A phone number is a set of numbers usually grouped by 2 or 3.
The only requirements of the chain are that the groups of numbers must be separated by a space and that the numbers (sets of groups of numbers) are separated by anything but a space. Which is my logical faith.

Function ExtractTelPortable(maChaine As String, x As Byte, sep As String, Optional tel As Boolean = True) As String
'Extraie des séries de Nº d'une chaîne
'- maChaine : the chain containing series of Nº
'- x : position of the number we are looking for in the chain
'- sep : separator that we want to place between the groups of numbers of the same Nº
'- tel : default "True" -> cellphones. If "False" -> phones


Dim i As Integer, j As Integer, trouve As String, cadena As String
    
    For n = 1 To x
        For i = 1 To Len(maChaine)
            trouve = Mid(maChaine, i, 1)
            If IsNumeric(trouve) Then
                maChaine = Right(maChaine, Len(maChaine) - i + 1) 'we remove everything that is not numeric left of the chain
                For j = 1 To Len(maChaine)
                    trouve = Mid(maChaine, j, 1)
                    If trouve <> " " And IsNumeric(trouve) = False Then
                        cadena = Trim(Left(maChaine, j - 1)) 'we only get the first set of digits (left) of "maChaine": the one that interests us
                        maChaine = Mid(maChaine, Len(cadena) + 1, Len(maChaine) - Len(cadena)) '"maChaine" is cut off from its first series of figures
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
    Next

    If tel Then 'we only want to recover the number of cellphones
        ExtractTelPortable = IIf(Left(cadena, 1) <> 0, "", Replace(cadena, " ", sep)) & "     | n = " & n
    Else 'we only want to recover the number of phones
        ExtractTelPortable = IIf(Left(cadena, 1) = 0, "", Replace(cadena, " ", sep)) & "     | n = " & n
    End If
End Function

The function works almost perfectly.
In the chain I give as an example, there are 6 phone numbers (we could have put a lot more).
If I want to extract only the mobile numbers, I will write (assuming that the string in question is in cell A25) in the cell (for example) A1:

= ExtractTelPortable ([A25]; 1; ".")
I "pull" all the way down to A6:
= ExtractTelPortable ([A25]; 6; ".")

In order to recover all the number of mobile.
You follow me ?

Curiously, the loop does not start with 1 but by 2 and the 6th number is the same as the 5th (which is logical considering the offset at the start of a number).
I put, at the end of the numbers of telephones returned by the function the value of n (see macro) to better show the problem.
Here, n should start with 1 and end with 6.
In the loop, n starts with 2 and ends with 7 ...

Could someone explain to me why to help me solve the problem?


Thank you in advance.

 

[pgc01]

Hi

Try this alternative code:

Function ExtractTelPortable(maChaine As String, n As Long, sep As String, Optional tel As Boolean = True) As String
'Extraie des séries de Nº d'une chaîne
'- maChaine : the chain containing series of Nº
'- n : position of the number we are looking for in the chain
'- sep : separator that we want to place between the groups of numbers of the same Nº
'- tel : default "True" -> cellphones. If "False" -> phones

Dim s As String

On Error GoTo Exit_Function
With CreateObject("VBScript.RegExp")
    .Pattern = "\b\d(\d| )*\b"
    .Global = True
    s = .Execute(maChaine)(n - 1)
End With

ExtractTelPortable = IIf(tel Xor (Not s Like "0*"), s, "") & "| n=" & n
Exit_Function:
End Function

Is this what you need?

 

[Fennek]

Hi,

have you considered something like this?

The code in  A1

Tel = split(split(cells(1,1), ":")(1), "&")

for i = 0 to ubound(Tel)
    msgbox Tel(i)
next i

regards
(untested)

 

[Magic_Doctor]

Hi,

Bravo pgc01, it works!

 

[Magic_Doctor]

I just realized that there was one last problem. The variable "sep" is not taken into account in the function. The usefulness of this variable is: if, for example:
sep = "." -> 094.54.20.44
sep = " " -> 094 54 20 44
sep = "" -> 094542044


How to use this variable in the function of pgc01?

 

[pgc01]

Hi

Just replace the separator:

...
ExtractTelPortable = [B][COLOR=#b22222]Replace([/COLOR][/B]IIf(tel Xor (Not s Like "0*"), s, "") & "|n=" & n[B][COLOR=#b22222], " ", sep)[/COLOR][/B]
...

 

[Magic_Doctor]

Obviously!!!

Thank you very much pgc01.

 

[pgc01]

I'm glad it helped.

 

[Magic_Doctor]

Hello pgc01,

Only to share. This is the purpose of the forums!

I come back with your solution on my usual forum (Excel Downloads).
Today, one of the participants of the forum tells me that we have every interest in declaring the object "VBScript.RegExp". Indeed, it avoids, if the function repeats itself - why not - many thousands of times, to recreate each time the object:

Option Explicit
Dim o As Object 'memorization to save time on the creation of the object "VBScript.RegExp"

---------------------------------------------------------------------------------------------------------------

Function ExtractTelPortable(maChaine As String, pos As Long, sep As String, Optional tel As Boolean = True) As String
'Extract of the numbers (series of grouped digits) of a string
'pgc01 / job75
'- maChaine : the chain containing series of Nº
'- pos : position of the number we are looking for in the chain
'- sep : separator that we want to place between the groups of numbers of the same Nº
'- tel : default "True" -> cellphones. If "False" -> fixed positions

Dim s As String

    On Error GoTo Exit_Function
    If o Is Nothing Then
        Set o = CreateObject("VBScript.RegExp")
        o.Pattern = "\b\d(\d| )*\b"
        o.Global = True
    End If
    s = o.Execute(maChaine)(pos - 1)

    ExtractTelPortable = Replace(IIf(tel Xor (Not s Like "0*"), s, ""), " ", sep)
Exit_Function:
End Function

Très bonne fin de soirée.