Extraire 2 chiffres d'une chaîne de caractères

[Magic_Doctor]

Bonjour,

J'ai une chaîne de caractères pouvant comporter 2 chiffres, voire un seul.
La chaîne peut se présenter de différentes manières, par exemple :
[12,3265] - [0,4562]
{12,3265} +/- {0,4562}
(12,3265) (0,4562)
12,3265 - 0,4562
12,3265 0,4562
[12,3265]
12,3265
.
.
.

Enfin, vous l'aurez compris, tous les cas de figure peuvent se présenter.
J'avais trouvé, je ne sais plus où, cette routine qui extraie un chiffre (mais pas 2) d'une chaîne :

Sub ExtractNumber()

toto = "[29,0915500] +/- [1,2587966]"
titi = Split(StrConv(toto, vbUnicode), Chr(0))

For i = 0 To UBound(titi)
  If Not IsNumeric(titi(i)) Then titi(i) = ""
  'Debug.Print titi(i) 'pour voir...
Next

bibi = Join(titi, "")
'zaza = Replace(bibi, ".", ",")

MsgBox (bibi)
'MsgBox (zaza) 'manifestement le séparateur pour la partie entière du chiffre et ses décimales a disparu...

End Sub

J'ai l'impression qu'il y a un problème avec les chiffres décimaux. Mais, enfin, c'est un début...
D'autre part, il semblerait que la fonction "StrConv", suivant son paramétrage, ne soit pas toujours compatible avec Mac (personnellement ça m'est égal, mais à vérifier).
Ah oui, j'oubliais, l'abominable format scientifique s'impose.
Par quel moyen peut-on extraire les 2 chiffres (pour ultérieurement les comparer entre eux) ou le chiffre unique si le cas se présente ?

Merci pour toute aide.

 

[job75]

Re : Extraire 2 chiffres d'une chaîne de caractères

Bonjour Magic_Doctor,

Cette macro extrait tous les nombres des textes étudiés :

Sub Extraire()
Dim c As Range, t As String, i%, s
Application.ScreenUpdating = False
[B:IV].ClearContents 'RAZ
For Each c In Range("A2", [A65536].End(xlUp))
  t = c.Text
  If t <> "" Then
    For i = 1 To 255
      If i <> 44 And i <> 46 And Not IsNumeric(Chr(i)) _
        Then t = Replace(t, Chr(i), " ")
    Next
    t = Application.Trim(t) 'SUPPRESPACE
    t = Replace(t, ",", ".")
    s = Split(t)
    For i = 0 To UBound(s)
      c(1, i + 2) = s(i)
    Next
  End If
Next
End Sub

Je ne me suis pas préoccupé de la rapidité d'exécution...

Fichier joint.

A+

 

[job75]

Re : Extraire 2 chiffres d'une chaîne de caractères

Re,

Ceci est quand même mieux car plus rapide :

Sub Extraire()
Dim c As Range, txt As String, i%, t As String, s
Application.ScreenUpdating = False
[B:IV].ClearContents 'RAZ
For Each c In Range("A2", [A65536].End(xlUp))
  txt = c.Text
  txt = Replace(txt, ",", ".")
  For i = 1 To Len(txt)
    t = Mid(txt, i, 1)
    If t <> "." And t <> " " And Not IsNumeric(t) _
      Then txt = Replace(txt, t, " ")
  Next
  txt = Application.Trim(txt) 'SUPPRESPACE
  s = Split(txt)
  For i = 0 To UBound(s)
    c(1, i + 2) = s(i)
  Next
Next
End Sub

Fichier (2).

A+

 

[Magic_Doctor]

Re : Extraire 2 chiffres d'une chaîne de caractères

Bonsoir job,

Merci beaucoup, c'est parfait !
J'ai fait quelques modifications, vu que ces chiffres extraits d'une chaîne ne seront manipulés que dans la macro et n'apparaîtront en fait jamais sur la feuille.
Quant à la rapidité, ma foi, ce n'est certes pas relativiste, mais avec uniquement 2 chiffres au maximum (une seule chaîne), cela devrait faire l'affaire. Il faut voir par la suite au sein d'une boucle ce que ça donnera.

Bonne fin de soirée.

 

[job75]

Re : Extraire 2 chiffres d'une chaîne de caractères

Bonjour Magic_Doctor, le forum,

Une fonction VBA est sans doute plus simple à utiliser, surtout dans une macro :

Function Extract(txt As String, n As Byte)
'n est le numéro d'ordre du nombre recherché
Dim i%, t As String, s
txt = Replace(txt, ",", ".")
For i = 1 To Len(txt)
  t = Mid(txt, i, 1)
  If t <> "." And t <> " " And Not IsNumeric(t) _
    Then txt = Replace(txt, t, " ")
Next
s = Split(Application.Trim(txt)) 'SUPPRESPACE
If n - 1 > UBound(s) Then Extract = "" Else Extract = Val(s(n - 1))
End Function

Dans le fichier joint elle est utilisée dans la feuille avec cette formule en B2 :

=Extract($A2;COLONNE()-1)

A+

 

[Magic_Doctor]

Re : Extraire 2 chiffres d'une chaîne de caractères

Bonjour le forum, job,

N'ayant pas rafraîchi l'écran, je n'ai pu voir ton dernier post.
En effet, c'est nettement plus rapide.
J'ai fait quelques modifications pour mon projet (aucun chiffre apparaissant sur la feuille) :

Sub Extraire2()
'job75 (adapté pour mon projet)

Dim cadena$, txt$, i%, t$, s, chiffre1, chiffre2
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a qu'un seul chiffre, sinon plantage

cadena = "[39,0915520] +/- [9,0915510]"
'cadena = "[29,0915500]"

txt = cadena
txt = Replace(txt, ",", ".")
For i = 1 To Len(txt)
    t = Mid(txt, i, 1)
    If t <> "." And t <> " " And Not IsNumeric(t) Then txt = Replace(txt, t, " ")
Next
txt = Application.Trim(txt) 'SUPPRESPACE
s = Split(txt)
chiffre1 = s(0) '1er chiffre
chiffre2 = s(1) '2ème chiffre

'**************************** Vérifications ****************************
[e3] = chiffre1 'marche
[e4] = chiffre2 'marche
[e5] = IIf(chiffre2 = "", "¡Sólo un número!", IIf(chiffre1 > chiffre2, "VRAI", "FAUX")) '--> ne marche pas
[e6] = InStr(cadena, chiffre1) 'position dans la chaîne "cadena" du début du 1er chiffre --> ne marche pas
[e7] = InStr(cadena, chiffre2) 'position dans la chaîne "cadena" du début du 2ème chiffre --> ne marche pas
[e8] = Len(chiffre1) 'marche
[e9] = Len(chiffre2) 'marche

End Sub

Et, comme noté dans la macro, il y a des résultats que je ne parviens pas à obtenir et je ne comprends pas pourquoi.

 

[job75]

Re : Extraire 2 chiffres d'une chaîne de caractères

Re Magic_Doctor,

Tu as vu ma fonction au post #5 ?

Dans ta macro, il faut que tu écrives :

chiffre1 = Val(s(0)) '1er chiffre
If UBound(s) > 0 Then chiffre2 = Val(s(1)) '2ème chiffre

On Error Resume Next est alors inutile.

Edit : au cas où tu ne le saurais pas InStr("aaaaa", "") renvoie toujours 1...

A+

 

[Magic_Doctor]

Re : Extraire 2 chiffres d'une chaîne de caractères

Bonjour job,

J'avais survolé ta fonction (n'ayant toujours pas rafraîchi l'écran...) mais... à 2h du mat et je n'ai plus eu le courage de la décortiquer.
En effet, tout y était dit. J'aurais dû y penser.
Maintenant je bataille avec les chiffres négatifs (j'ai oublié de stipuler, dans ma requête initiale, cette éventualité) :
cadena = "[39,0915520] +/- [-9,0915510]"
pour "chiffre2" j'obtiens 9,0915510 et non pas -9,0915510

Quoi qu'il en soit, bonne journée à toi.

 

[job75]

Re : Extraire 2 chiffres d'une chaîne de caractères

Re,

Bon d'accord, s'il y a des signes - juste devant les nombres :

Function Extract(txt As String, n As Byte)
'n est le numéro d'ordre du nombre recherché
Dim i%, t As String, u As String, s
txt = Replace(txt, ",", ".")
For i = 1 To Len(txt)
  t = Mid(txt, i, 1): u = Mid(txt, i, 2)
  If t <> "." And Not (t Like "#" Or u Like "-#") Then _
    txt = Application.Replace(txt, i, 1, " ") 'fonction REMPLACER
Next
s = Split(Application.Trim(txt)) 'SUPPRESPACE
If n - 1 > UBound(s) Then Extract = "" Else Extract = Val(s(n - 1))
End Function

Fichier (2).

A+

 

[david84]

Re : Extraire 2 chiffres d'une chaîne de caractères

Bonjour, salut Gérard,
je n'ai pas tout suivi mais ci-joint une fonction utilisant une expression rationnelle.

Function Extract2(c As String, r As Byte)
Dim oRegExp As Object, Occ As Object
Set oRegExp = CreateObject("vbscript.regexp")
oRegExp.Global = True
oRegExp.Pattern = "-?[0-9]+(?:,[0-9]+)*"
If oRegExp.test(c) Then
    Set Occ = oRegExp.Execute(c)
    If r <= Occ.Count Then: Extract2 = Occ.Item(r - 1): Else: Extract2 = ""
Else
    Extract2 = ""
End If
End Function

Fonction testée sur le dernier fichier de Gérard, à compléter si nécessaire en fonction des cas rencontrés.
A vérifier également la vitesse d'exécution sur des plages importantes car si le regexp est un outil puissant sur les chaînes de caractères, la vitesse de traitement n'est pas son point fort.
A+

 

[Magic_Doctor]

Re : Extraire 2 chiffres d'une chaîne de caractères

Merci job, ça marche impec !