Extraction des chiffres pour créer un nombre dans une chaîne alphanumérique [Résolu]

[nimiquel]

Bonjour,

Je souhaiterais extraire uniquement les chiffres contenu dans plusieurs cellules pour ensuite pouvoir les comparer.
Je souhaite intégrer cela dans une macro VBA.

par exemple, j'ai ARF234 et df234 dans deux cellules différentes. Le but étant que si le nombre créé par les chiffres extraits dans les 2 cellules sont les mêmes (ici ce sera donc 234) alors la condition est vrai et donc action.

Quelqu'un peut-il m'aider pour effectuer cette extraction et surtout bien obtenir deux chiffres à comparer (sachant qu'il faut aussi que je considère peut-etre le cas où certaines cellules ne contiennent pas de chiffres)?

Bonne journée

[jfontaine]

Bonjour,

Une solution consiste a se créer sa propre fonction

Cette proposition retourne EGAL si identique sinon PAS EGAL

A mettre dans un module

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function CompareNombre(rg1 As Range, rg2 As Range) As String
 
Dim Lng1 As Long
Dim Lng2 As Long
 
Dim i As Integer
 
For i = 1 To Len(rg1.Value)
    If IsNumeric(Mid(rg1.Value, i, 1)) Then Lng1 = Lng1 & Mid(rg1.Value, i, 1)
Next i
For i = 1 To Len(rg2.Value)
    If IsNumeric(Mid(rg2.Value, i, 1)) Then Lng2 = Lng2 & Mid(rg2.Value, i, 1)
Next i
 
CompareNombre = IIf(Lng1 = Lng2, "EGAL", "PAS EGAL")
 
End Function

A utiliser en formule

Code :

=CompareNombre(A1;B1)

[patricktoulon]

bonjour nimiquel

pour jfontaine

ca marche mieux comme ca

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
 
Function CompareNombre(rg1, rg2) As String
 
Dim Lng1 As Long
Dim Lng2 As Long
 
Dim i As Integer
 
For i = 1 To Len(rg1.Value)
    If IsNumeric(Mid(rg1.Value, i, 1)) Then Lng1 = Lng1 & Mid(rg1.Value, i, 1)
Next i
For i = 1 To Len(rg2.Value)
    If IsNumeric(Mid(rg2.Value, i, 1)) Then Lng2 = Lng2 & Mid(rg2.Value, i, 1)
Next i
 
CompareNombre = IIf(Lng1 = Lng2, "EGAL", "PAS EGAL")
 
End Function
Sub voyons_si_c_est_egal()
lareponse = CompareNombre(Range("A1"), Range("A2"))
MsgBox lareponse
End Sub

au plaisir

[jfontaine]

Salut Patrick

Que veux tu dire par

ca marche mieux comme ca

[nimiquel]

Bon je suis mauvais en codage mais comment intégrer votre fonction dans mon if?

Voici le code alors le if de départ qui ne marchait pas

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    For nw = 2 To Nb_Lignes
        For nz = 2 To Nb_LigneC
 
If (Sheets("Global").Range("G" & nw) Like Sheets("EPR").Range("F" & nz)) Then
 
Sheets("Global").Range("P" & nw) = Sheets("EPR").Range("F" & nz)
Sheets("Global").Range("Q" & nw) = Sheets("EPR").Range("G" & nz)
Sheets("Global").Range("R" & nw) = Sheets("EPR").Range("H" & nz)
Sheets("Global").Range("S" & nw) = Sheets("EPR").Range("AX" & nz)
 
End If
 
        Next nz
    Next nw

Merci encore pour l'aide.

[jfontaine]

Essais comme cela

Code :

If CompareNombre(Sheets("Global").Range("G" & nw),Sheets("EPR").Range("F" & nz)) = "EGAL" then

[patricktoulon]

bonjour jfontaine

j'ai essayer ton code comme tu l'a donné et visiblement les variables

n'etait pas pris en compte comme elle devait l'etre
d'ou le

Code :

lareponse = CompareNombre(Range("A1"), Range("A2"))

a la place de ta version

Code :

=CompareNombre(A1;B1)

en ayant le type de variable dans la fonction et non dans l'appel a la fonction

au plaisir

[nimiquel]

Il me sort une "incompatibilté de type" sur la ligne suivante:

Code :

For i = 1 To Len(rg1.Value)

Je crois comprendre que cela arrive lorsque je n'ai pas de chiffre dans ma chaîne de caractère ou que la cellule est vide.
Sinon je crois que ça marche sans problème.
Ca mérite une condition supplémentaire c'est ça? Vous avez une piste?

[jfontaine]

Ca mérite une condition supplémentaire c'est ça?

Dans le cas une cellule vide on aura

Code :

For i = 1 to 0

D'ou un problème car le pas d'avancement d'une boucle For est + 1

Ajoutes un test de contrôle que tes cellules sont bien pleines
Ce test peut être ajouté à la fonction

[issoram]

Tu peux utiliser aussi la fonction val et t'inspirer de la partie "Extraire toutes les valeurs numériques (entiers et décimales) contenues dans une chaîne" de ce tutoriel sur la manipulation des chaines de caractères: http://silkyroad.developpez.com/VBA/...racteres/#LI-P

Cordialement.

[Theze]

Bonjour,

La fonction de Jérôme marche très bien, une variante avec "Instr" :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Function CompareNombre(rg1 As Range, rg2 As Range) As String
 
    Dim Lng1 As Long
    Dim Lng2 As Long
 
    Dim i As Integer
 
    For i = 1 To Len(rg1.Value)
        If InStr("0123456789", (Mid(rg1.Value, i, 1))) <> 0 Then Lng1 = Lng1 & Mid(rg1.Value, i, 1)
    Next i
 
    For i = 1 To Len(rg2.Value)
        If InStr("0123456789", (Mid(rg2.Value, i, 1))) <> 0 Then Lng2 = Lng2 & Mid(rg2.Value, i, 1)
    Next i
 
    CompareNombre = IIf(Lng1 = Lng2, "EGAL", "PAS EGAL")
 
End Function

Hervé.

[mercatog]

Bonjour un tous
Une autre proposition utilisant les expressions régulières (Nécessite l'activation de la référence VBScript Regular Expressions 5.5)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
'Nécessite l'activation de la référence VBScript Regular Expressions 5.5
Function Comp(ByVal MotA As String, ByVal MotB) As Boolean
Dim Reg As New VBScript_RegExp_55.RegExp
 
With Reg
    .Pattern = "\D"
    .Global = True
    MotA = .Replace(MotA, "")
    MotB = .Replace(MotB, "")
End With
Set Reg = Nothing
Comp = MotA = MotB
End Function

La fonction Comp retourne True si MotA et MotB contiennent le même nombre après élimination de tous les autres caractères.

[patricktoulon]

bonjour

pour mercatog

waouahh!! ca c'est du costaud je garde!!!

[nimiquel]

Je viens d'essayer la méthode de Theze (et de Jérome) et ça marche mieux mais pas lorsqu'une des cellules est vide.
Pour la méthode de mercatog, je crois tout simplement que je n'ai pas la possibilité d'activer VBScript_RegExp_55.RegExp ... dommage!
Mais merci pour tout.

[jfontaine]

Je viens d'essayer la méthode de Theze (et de Jérome) et ça marche mieux mais pas lorsqu'une des cellules est vide.

Adapte le code pour prendre en compte ce cas.
Soit dans la fonction, soit avant l'appel de la fonction

[mercatog]

Bonjour
Pour ne pas activer la référence, la même fonction

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Function Comp(ByVal MotA As String, ByVal MotB) As Boolean
Dim Reg As Object
 
Set Reg = CreateObject("vbscript.regexp")
With Reg
    .Pattern = "\D"
    .Global = True
    MotA = .Replace(MotA, "")
    MotB = .Replace(MotB, "")
End With
Set Reg = Nothing
Comp = MotA = MotB
End Function

[nimiquel]

Salut Mercatog,

Comment intégrer ta fonction dans ma macro ?
Je suppose que c'est du genre:

Code :

If Comp = ??? Then

mais je ne vois pas ce que la fonction renvoie.

Merci

[mercatog]

Relis plus haut

La fonction Comp retourne True si MotA et MotB contiennent le même nombre après élimination de tous les autres caractères.

Type

Code :

1
2
3
4
5
6
7
8
Dim Str1 as string, Str2 as string
Str1="élém2_ 36 B 5"
Str2="2AB3_vg65Mta"
If Comp(Str1,Str2) Then
   Msgbox "Même nombres contenus dans les 2 chaînes"
else
   Msgbox "Nombres contenus sont différents"
end if

Remarque, Si les 2 chaines ne contiennent pas de chiffres ou l'une ne contient pas de chiffres et l'autre vide alors Comp est aussi true

[patricktoulon]

bonjour mercatog

purrée ci avec ca il ne s'en sort pas !

une question, a quoi sert le "\D" .moi vouloir apprendre

au plaisir

[mercatog]

Bonjour Patrick
Plutôt je donnerai un lien intéressant: Les Expressions Rationnelles appliquées en VBA Access Par Charles A