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