IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

extraction de valeurs numériques d'une chaîne de caractères [XL-2016]


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti

    Homme Profil pro
    Electronicien
    Inscrit en
    Février 2014
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France

    Informations professionnelles :
    Activité : Electronicien

    Informations forums :
    Inscription : Février 2014
    Messages : 20
    Par défaut extraction de valeurs numériques d'une chaîne de caractères
    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

  2. #2
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut 4 solutions à te proposer
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  3. #3
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 84
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Par défaut
    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

  4. #4
    Membre averti

    Homme Profil pro
    Electronicien
    Inscrit en
    Février 2014
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France

    Informations professionnelles :
    Activité : Electronicien

    Informations forums :
    Inscription : Février 2014
    Messages : 20
    Par défaut
    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.

  5. #5
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    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)
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  6. #6
    Membre averti

    Homme Profil pro
    Electronicien
    Inscrit en
    Février 2014
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France

    Informations professionnelles :
    Activité : Electronicien

    Informations forums :
    Inscription : Février 2014
    Messages : 20
    Par défaut re
    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

  7. #7
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 84
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Par défaut
    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)

  8. #8
    Membre averti

    Homme Profil pro
    Electronicien
    Inscrit en
    Février 2014
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France

    Informations professionnelles :
    Activité : Electronicien

    Informations forums :
    Inscription : Février 2014
    Messages : 20
    Par défaut
    Citation Envoyé par unparia Voir le message
    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

  9. #9
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 84
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Par défaut
    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à.

  10. #10
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  11. #11
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    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
    Nom : demo2.gif
Affichages : 2766
Taille : 322,1 Ko
    ouais !!?? il est ou ton soucis
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [CR XI] extraire la partie numérique d'une chaïne de caractère
    Par kikidrome dans le forum SAP Crystal Reports
    Réponses: 3
    Dernier message: 29/11/2010, 11h26
  2. Modifier la valeur numérique dans une chaîne de caractère
    Par ab1to dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 29/03/2010, 14h08
  3. Réponses: 2
    Dernier message: 12/11/2009, 16h34
  4. Réponses: 2
    Dernier message: 08/07/2008, 11h50
  5. sortir deux valeurs numériques d'une chaine de caractères
    Par Ness2000 dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 08/07/2008, 08h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo