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

**nimiquel** · 16/09/2011, 09h47

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** · 16/09/2011, 10h51

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 :

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
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 :

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

=CompareNombre(A1;B1)

**patricktoulon** · 16/09/2011, 13h16

bonjour nimiquel

pour jfontaine

ca marche mieux comme ca

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
 
 
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** · 16/09/2011, 13h21

Salut Patrick

Que veux tu dire par

ca marche mieux comme ca

**nimiquel** · 16/09/2011, 14h33

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 :

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

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** · 16/09/2011, 14h38

Essais comme cela

Code :

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

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

**patricktoulon** · 16/09/2011, 14h42

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 :

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

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

a la place de ta version

Code :

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

=CompareNombre(A1;B1)

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

au plaisir

**nimiquel** · 16/09/2011, 14h56

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

Code :

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

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** · 16/09/2011, 15h14

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

Dans le cas une cellule vide on aura

Code :

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

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** · 17/09/2011, 17h08

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** · 17/09/2011, 18h08

Bonjour,

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

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
 
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** · 17/09/2011, 19h15

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 :

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

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** · 18/09/2011, 16h38

bonjour

pour mercatog

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

**nimiquel** · 19/09/2011, 10h01

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** · 19/09/2011, 10h06

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** · 19/09/2011, 13h06

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

Code :

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

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** · 19/09/2011, 13h23

Salut Mercatog,

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

Code :

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

If Comp = ??? Then

mais je ne vois pas ce que la fonction renvoie.

Merci

**mercatog** · 19/09/2011, 13h31

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 :

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

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