Discussion :

[djank]

Bonjour,

je souhaite extraire les valeurs numériques d'une chaine de caractère, et pour cela j'ai utilisé une routine que j'ai trouvé sur ce forum :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Sub extraireValeursNumeriques_DansChaine()
    Dim i As Byte, Nb As Byte
    Dim Cible As String, Resultat As String
    Dim Nombre As Double
 
    Cible = "y = 2,851108E-09x3 - 1,671366E-06x2 + 1,023384E-03x + 2,591152E-02
R² = 9,999446E-01"
    'Pour que fonction Val puisse reconnaitre les décimales: Remplacement des
    'virgules par des points
    Cible = Replace(Cible, ",", ".")
    'Pour gérer deux nombres qui se suivent: remplacement des espaces
    'par un caractère Alpha
    Cible = Replace(Cible, " ", "x")
 
    For i = 1 To Len(Cible)
        If IsNumeric(Mid(Cible, i, 1)) Then
        Nombre = Val(Mid(Cible, i, Len(Cible) - i + 1))
        Nb = Nb + 1
        Resultat = Resultat & Nombre & vbLf
        i = i + Len(Str(Nombre)) - 1
        End If
    Next
 
    MsgBox "Il y a " & Nb & " valeurs numériques dans la cellule " & vbLf & Resultat
End Sub

le problème que je rencontre c'est que les 2 premières expressions numériques sont bien rendues mais les suivantes sont séparées de leur puissance exemple :
1er expression = 2,85111E-09
2ème expression = 1,67137E-06
3ème expression = 0,001023384
4 ème expression = 3
5ème expression = 0,02591152
6ème expression = 2
7ème expression = 0,9999446
8ème expression = 1

auriez-vous une solution à me proposer?

Merci d'avance

[patricktoulon]

je me suis un peu amuser avec ton truc
j'ai d'abords pensé a un regex mais ta chaine n'etant qu'un exemple parmis certainement d'autre je me suis rabbatu sur des fonction string de VBA

fonction utilisées

1. Instr
2. InstRev
3. Split
4. Mid
5. Replace
6. like
7. trim
8. application.trim
9. join pour le demo dans le debug

solution N° 1
elle ne fonctionnera que si tes nombres commencent par un chiffre et une virgule
ici on commence par la fin vers le debut (utilisation de la fonction InstrRev)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub test1()
        'en partant de la fin de la chaine de base  Dim texte As String
    texte = "y = 2,851108E-09x3 - 1,671366E-06x2 + 1,023384E-03x + 2,591152E-02"    'base
    Debug.Print "texte de base: " & texte    ' voir dans debug
    Do While texte Like "*,*" 'boucle tant que texte contient une virgule
        x = InStrRev(texte, ",") - 1 'x est l'index de placement de la virgule -1 pour le chiffre
        Debug.Print Split(Mid(texte, x), "x")(0) 'on affiche le chiffre en le coupnant a partir de "x"  et en gardant ce qui est devant
        texte = Mid(texte, 1, x - 2) 'on enleve ce que l'on a visté dans la chaine de base
    Loop
End Sub

Solution N° 2
elle aussi fonctionnera que si tes nombres commencent par un chiffre et une virgule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test2()
'en partant du debut de la chaine de base
    texte = "y = 2,851108E-09x3 - 1,671366E-06x2 + 1,023384E-03x + 2,591152E-02"    'base
    Debug.Print "texte de base: " & texte    ' voir dans debug
    Do While texte Like "*,*"    'boucle tant que texte contient une virgule
        x = InStr(1, texte, ",") - 1    'x est l'index de placement de la virgule -1 pour le chiffre
        deb = Split(Mid(texte, x), "x")(0) 'recupération du nombre Alphanumerique
        Debug.Print deb ' affichage du nombre dans le debug
        texte = Replace(texte, deb, "") 'suppression du nombre dans la chaine de base
    Loop
End Sub

Solution N°3 ma 2d préférée
celle si par contre fonctionnera avec tout nombres divers decimale ( avec une virgule)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test3()
'en partant du debut de la chaine de base avec des entier de plusieur chiffre (ou pas d'ailleurs!!!!)
    texte = "y = 4523612,851108E-09x3 - 321,671366E-06x2 + 54281,023384E-03x + 1252,591152E-02"    'base
    Debug.Print "texte de base: " & texte    ' voir dans debug
    Do While texte Like "*,*"    'boucle tant que texte contient une virgule
        x = InStr(1, texte, ",")     'x est l'index de placement de la virgule -1 pour le chiffre
        tbl = Split(Mid(texte, 1, x - 1), " ")
        entier = tbl(UBound(tbl))
        deb = entier & Split(Mid(texte, x), "x")(0) 'recupération du nombre Alphanumerique
        Debug.Print deb ' affichage du nombre dans le debug
        texte = Replace(texte, deb, "") 'suppression du nombre dans la chaine de base
    Loop
End Sub

Solution N4 ma préf des préf
celle si fonctionnera avec tout nombres entier ou decimals
elle n'est pas basée sur les "," comme les 3 autres mais sur les "x"
le principe etant d'identifier les chaines commencant par "x" et terminant par "-"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub test4()
'en partant du debut de la chaine de base
    texte = "y = 4523612,851108E-09x3 - 321,671366E-06x2 + 54281,023384E-03x + 1252,591152E-02x12 +121568767jkhjk125466"    'base
    Debug.Print "texte de base: " & texte    ' voir dans debug
    texte = Trim(Split(Replace(texte, "+", "-"), "=")(1))
    Debug.Print "texte modifié: " & texte    ' voir dans debug
    tbl = Split(texte, "x")
    For i = LBound(tbl) To UBound(tbl)
        texte = Application.Trim(Replace(texte, Split("x" & tbl(i), "-")(0) & "-", " "))
    Next
    Debug.Print "texte balisé: " & texte    ' voir dans debug
    tbl = Split(texte, " ")
    Debug.Print "liste"
    Debug.Print Join(tbl, vbCrLf)    ' voir dans debug
End Sub

allez une 5eme pour la route
Solution N 5
pareil par les x on garde le split(0) de chaque split(x)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test7()
'en partant du debut de la chaine de base
    texte = "y = 4523612,851108E-09x3 - 321,671366E-06x2 + 54281,023384E-03x + 1252,591152E-02x12 +121568767jkhjk125466"    'base
    Debug.Print "texte de base: " & texte    ' voir dans debug
    texte = Trim(Split(Replace(texte, "+", "-"), "=")(1))
    Debug.Print "texte modifié: " & texte    ' voir dans debug
    tbl = Split(texte, "x")
    For i = LBound(tbl) To UBound(tbl)
        Debug.Print Split(tbl(i), " ")(UBound(Split(tbl(i), " ")))
    Next
End Sub

j'aurais bien fait une demo avec un regex mais je pense que la 3 et 4 qui sont plus souple en terme de chaine de base a annalyser feront l'affaire
le toulonnais fait mumuse

[unparia]

Bonjour djank

J'ai apparemment une autre lecture de ta demande.
Et te propose donc cette solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim toto As String, k As Integer, n As Integer, titi, tata
  toto = "y = 2,851108E-09x3 - 1,671366E-06x2 + 1,023384E-03x + 2,591152E-02"
  titi = Array(" + ", " - ", "x", "=", " ")
  For k = 0 To UBound(titi) - 1
    toto = Replace(toto, titi(k), Chr(1))
  Next
  titi = Split(toto, Chr(1))
  ReDim tata(UBound(titi))
  n = 0
  For k = 0 To UBound(titi)
    If IsNumeric(titi(k)) Then
       tata(n) = Val(Replace(titi(k), ",", "."))
       n = n + 1
    End If
  Next
  ReDim Preserve tata(n - 1)
  For k = 0 To UBound(tata)
   MsgBox tata(k)
  Next

[djank]

patricktoulon, unparia

Bonjour et merci pour l’intérêt que vous portez à mon problème.

Comme vous l'aurez compris je n'ai pas une grande maîtrise du VBA, et pour moi c'est donc une aide précieuse que vous m'apportez pour progresser dans mon apprentissage.

Je vais expérimenter vos solution et vous ferais un retour dès que possible, merci encore.

[patricktoulon]

Bonjour unparia et djank

a utiliser un redim preserve tableau j'en ai une autre
le principe est simple

1. boucle sur le len
2. on prends en compte qu'a partir du premier numerique
3. on ne prend plus en compte a partir de "x"et on ajoute une ligne au tableau
4. reprend en compte qu' a partir du "-" ou "+" qui suit
5. une seule boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test6()
    Dim ok As Boolean, sy As Boolean, tablo(), a&, char$
    texte = "y = 4523612,851108E-09x3 - 321,671366E-06x2 + 54281,023384E-03x + 1252,591152E-02x12 +121568767jkhjk125466"
    ok = True
    ReDim Preserve tablo(1)
    a = 0
    For i = 1 To Len(texte)
        char = Mid$(texte, i, 1)
        If IsNumeric(char) Then d = True
        If d = True Then
            If char = "x" Then ok = False: char = "": a = a + 1: ReDim Preserve tablo(a)
            If (char = "-" Or char = "+") And ok = False Then ok = True: char = ""
            If ok = True Then tablo(a) = tablo(a) & IIf(char <> " ", char, "")
        End If
    Next
    'Debug.Print res
    Debug.Print Join(tablo, vbCrLf)
End Sub

elle est relativement simple
et l'avantage aussi c'est que la chaine peut avoir des entier de plusieurs chiffres et des entier tout court (sans decimales)

[djank]

unparia : ta solution fonctionne, je dois l'adapter pour avoir les x3, x2 et x ainsi que les signes sur la même ligne que les constantes.
pour être plus clair :
2,851108E-09x3
- 1,671366E-06x2
1,023384E-03x
2,591152E-02
j'ai "du pain sur la planche" avant de comprendre ce que tu as fait avec le tableau, mais je ne lache pas, encore merci.


patricktoulon : merci également j'ai voulu rajouter une boucle pour afficher le résultat dans des cellules mais je ne comprend pas pourquoi le résultat dans les cellules est différent du résultat dans MsgBox?

voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test6()
    Dim ok As Boolean, sy As Boolean, tablo(), a&, char$
    texte = "y = 2,851108E-09x3 - 1,671366E-06x2 + 1,023384E-03x + 2,591152E-02"
    ok = True
    ReDim Preserve tablo(1)
    a = 0
    For i = 1 To Len(texte)
        char = Mid$(texte, i, 1)
        If IsNumeric(char) Then d = True
        If d = True Then
            If char = "x" Then ok = False: char = "": a = a + 1: ReDim Preserve tablo(a)
            If (char = "-" Or char = "+") And ok = False Then ok = True: char = ""
            If ok = True Then tablo(a) = tablo(a) & IIf(char <> " ", char, "")
        End If
    Next
    'Debug.Print res
    l = 5
    MsgBox Join(tablo, vbLf)
    For j = 0 To UBound(tablo)
    Range("G" & l) = tablo(j)
    l = l + 1
    Next
    Debug.Print Join(tablo, vbCrLf)
End Sub

[unparia]

A djank :
Tu comptes changer d'avis sur ce que tu veux combien de fois ?
J'espère que c'est la dernière, sinon j'arrête-là :
Voici donc pour ton dernier choix --->>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim toto As String, titi As String, k As Integer, tt() As Byte, tata
  toto = "y = 2,851108E-09x3 - 1,671366E-06x2 + 1,023384E-03x + 2,591152E-02"
  titi = Replace(toto, " -", Chr(1) & "-")
  Do While Val(titi) = 0
    titi = Mid(titi, 2)
  Loop
  tt = StrConv(titi, vbFromUnicode)
  For k = 0 To UBound(tt)
    If tt(k) = 43 Then tt(k) = 1
  Next
  tata = Split(StrConv(tt, vbUnicode), Chr(1))
  For k = 0 To UBound(tata)
     MsgBox tata(k)
   Next
End Sub

(Là, tu vas en avoir un peu plus, du "pain sur la planche"; c'est sûr)

[djank]

A djank :
Tu comptes changer d'avis sur ce que tu veux combien de fois ?
J'espère que c'est la dernière, sinon j'arrête-là :
Voici donc pour ton dernier choix --->>

Merci encore,
et non je ne change pas d'avis !!
je serais désolé que tu te sentes obligé de répondre, aussi si cela t'exaspère une solution radicale : ne pas répondre ;-)
bonne soirée

[unparia]

Cela ne m'exaspère ps, djank, mis compare la forme de ce que tu demandais initalement :

1er expression = 2,85111E-09
2ème expression = 1,67137E-06
...

avec celle que tu demandes maintenant -->>

2,851108E-09x3
- 1,671366E-06x2
...

ce n'est ni la même chose, ni le même code à écrire ..
Je te laisse maintenant là.

[patricktoulon]

re
Ah oui !!! moi non plus la je pige plus
tu les veux ces "x" ou pas faudrait savoir
ta demande initiale etait de choper toute les valeur alpha numerique qui s'arrete a "x" et separées par des "+" ou "-" on t'a donné 36 solutions toutes testées qui fonctionnent
je suis meme allé un peu plus loin !!!dans les derniere je t'ai proposé des modeles qui pouvaient en meme temps recupérer des decimales alphanumerique ou des entier
si avec ca tu n'y arrive pas je crois que l'on peut plus rien pour toi

[patricktoulon]

patricktoulon : merci également j'ai voulu rajouter une boucle pour afficher le résultat dans des cellules mais je ne comprend pas pourquoi le résultat dans les cellules est différent du résultat dans MsgBox?

la bonne blague
peut etre parce que VBA convertie les nombre alphanumerique en nombre et se retrouve abrégés dans les cellules ma fois
peut etre que si tu mettais les cellule de destination en format text tu aurais moins de soucis

boucler !!! pourquoi faire ton tableau tu la deja avec "tablo" transpose c'est tout
demo avec la deniere version

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub test6()
    Dim ok As Boolean, sy As Boolean, tablo(), a&, char$
    texte = Cells(2, "D").Text
    ok = True
    ReDim Preserve tablo(1)
    a = 0
    For i = 1 To Len(texte)
        char = Mid$(texte, i, 1)
        If IsNumeric(char) Then d = True
        If d = True Then
            If char = "x" Then ok = False: char = "": a = a + 1: ReDim Preserve tablo(a)
            If (char = "-" Or char = "+") And ok = False Then ok = True: char = ""
            If ok = True Then tablo(a) = tablo(a) & IIf(char <> " ", char, "")
        End If
    Next
    With Range("G5").Resize(UBound(tablo) + 1, 1)
        .ClearContents
        .NumberFormat = "@"
        .Value = Application.Transpose(tablo)
    End With
End Sub

visuel

ouais !!?? il est ou ton soucis