extraire les chiffres d'une cellule

**Timi493** · 31/12/2013, 08h57

Bonjour à tous,
Il existe de nombreuses solutions mais aucune ne me va bien.

Comment affecter à x la valeur de toutes les lettres de l’alphabet et les caractère "-" et "_"

Je recherche les chiffres de droite dans une cellule et à les extraire dans la cellule suivante
Ci-dessous des valeurs d'exemple
s1 => extraire 1
trz12 => extraire 12
da-35 => extraire 35
trv- 54 => extraire 54
vtr2_10 => extraire 10
bv2a-5 => extraire 5
b2-4a => extraire 4a (pour ici pas grave si ça ne marche pas).

Mon problème est que je n'ai pas toujours un espace ou un tiret ou autre chose comme repère, cela peut-être un caractère ou n'importe quelle lettre qui précède les chiffres, et je n'ai pas trouvé malqué de nombreuse recherche.
Voici ma macro actuelle.
Merci pour votre aide.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ordre()
 
Dim Cellule As Range
 Dim txt As String
 Dim x As Variant
 For Each Cellule In Selection
 
  txt = Cellule.Text
  x = Split(txt, "a") 'la macro ne cherche que la valeur a, je veux tout chercher sauf de 1 à 9
  Cellule.Offset(0, 1) = x(UBound(x))
 
 Next Cellule
 
End Sub

**boisgontierjacques** · 31/12/2013, 09h25

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Function NumChaineDernOccur(chaine)
  longueur = Len(chaine): If longueur = 0 Then NumChaineDernOccur = 0: Exit Function
  temp = ""
  p = longueur
  Do While Not IsNumeric(Mid(chaine, p, 1)) And p > 1
    p = p - 1
  Loop
  Do While IsNumeric(Mid(chaine, p, 1)) And p > 0
    temp = Mid(chaine, p, 1) & temp
    p = p - 1: If p = 0 Then Exit Do
  Loop
  NumChaineDernOccur = Val(temp)
End Function

ou

Code :

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

1
2
3
4
5
6
7
8
 
Function Num(chaine)
  Set obj = CreateObject("vbscript.regexp")
  obj.Global=True
  obj.Pattern = "\d+"
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then Num = Val(a(a.Count - 1)) Else Num = 0
End Function

Jacques Boisgontier

Invité · 31/12/2013, 09h33

Bonjour,

Une autre solution que celle de Jacques mais moins compacte

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Function RechercheChiffres(ByVal CelluleTestee As Range) As String
 
Dim Ctr As Long
Dim PositionPremierChiffre As Long
Dim Continuer As Boolean
 
 Continuer = True
 RechercheChiffres = ""
 Select Case Len(CelluleTestee)
  Case 2
 
    For Ctr = Len(CelluleTestee) To 1 Step -1
        Select Case Mid(CelluleTestee, Ctr, 1)
            Case 0 To 9
                PositionPremierChiffre = Ctr
            Case Else
                Exit For
        End Select
    Next Ctr
    RechercheChiffres = Mid(CelluleTestee, PositionPremierChiffre)
 
  Case Is > 2
        ' Cas avec dernier caractère comme chiffre
        For Ctr = Len(CelluleTestee) To 1 Step -1
            Select Case Mid(CelluleTestee, Ctr, 1)
                Case 0 To 9
                    PositionPremierChiffre = Ctr
                    Continuer = False
                Case Else
                    Exit For
            End Select
        Next Ctr
        If Continuer = False Then
            RechercheChiffres = Mid(CelluleTestee, PositionPremierChiffre)
        Else
            ' Pour prendre en compte les cas d'une valeur alphanumérique en dernier caractère
            For Ctr = Len(CelluleTestee) - 1 To 1 Step -1
                Select Case Mid(CelluleTestee, Ctr, 1)
                    Case 0 To 9
                        PositionPremierChiffre = Ctr
                    Case Else
                        Exit For
                End Select
            Next Ctr
            RechercheChiffres = Mid(CelluleTestee, PositionPremierChiffre)
        End If
 End Select
 
End Function

Vous n'indiquez pas le cas 1S, ma fonction ne fonctionne pas pour ce cas.

Cordialement.

**illight** · 31/12/2013, 09h33

Il faudrait peut-être passer par le code ASCII des caractères, et faire une boucle sur tous les caractères en partant de la fin.

Un truc dans ce genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub toto()
For i = 1 To 2
    nb = 0
    For j = Len(Range("A" & i).Value) To 1 Step -1
        If Asc(Mid(Range("A" & i).Value, j, 1)) >= 48 And Asc(Mid(Range("A" & i).Value, j, 1)) <= 57 Then
            nb = nb + 1
        End If
    Next j
    Range("B" & i).Value = Right(Range("A" & i).Value, nb)
Next i
End Sub

EDIT : quelle synchro, 3 réponses en meme temps

Invité · 31/12/2013, 09h45

Envoyé par Eric KERGRESSE

Vous n'indiquez pas le cas 1S, ma fonction ne fonctionne pas pour ce cas.

Cordialement.

Correction :

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
27
28
29
30
31
32
33
34
35
Function RechercheChiffres(ByVal CelluleTestee As Range) As String
 
Dim Ctr As Long
Dim PositionPremierChiffre As Long
Dim Continuer As Boolean
 
 Continuer = True
 RechercheChiffres = ""
 
        ' Cas avec dernier caractère comme chiffre
        For Ctr = Len(CelluleTestee) To 1 Step -1
            Select Case Mid(CelluleTestee, Ctr, 1)
                Case 0 To 9
                    PositionPremierChiffre = Ctr
                    Continuer = False
                Case Else
                    Exit For
            End Select
        Next Ctr
        If Continuer = False Then
            RechercheChiffres = Mid(CelluleTestee, PositionPremierChiffre)
        Else
            ' Pour prendre en compte les cas d'une valeur alphanumérique en dernier caractère
            For Ctr = Len(CelluleTestee) - 1 To 1 Step -1
                Select Case Mid(CelluleTestee, Ctr, 1)
                    Case 0 To 9
                        PositionPremierChiffre = Ctr
                    Case Else
                        Exit For
                End Select
            Next Ctr
            RechercheChiffres = Mid(CelluleTestee, PositionPremierChiffre)
        End If
 
End Function

**Timi493** · 31/12/2013, 10h07

Merci beaucoup pour toutes ces réponses et la rapidité.
je vais éplucher et vous dire ce qui est bien pour moi.
je valide résolu dès que c'est bon (peut-être pas ce jour) ...

**Timi493** · 31/12/2013, 10h37

Finalement je n’ai pas résisté à la tentation de tester.
Je prends la solution d’Eric.
Merci à tous.

**Timi493** · 31/12/2013, 15h31

Encore moi,
Bien, après pas mal de test je me suis fixé sur la solution de Jacques.
Elle ne prends pas en compte l'éventuelle dernière lettre mais me permet un trie numérique à la suite.
Et ne signale pas d'erreur si la cellule à convertir est vide.
Dans tout les cas les deux sont top.
Encore mille merci.
Et tous mes voeux pour 2014.

**Marc-L** · 31/12/2013, 16h32

Bonjour,

voici une autre fonction, prenant en compte la dernière lettre et ne renvoyant pas d'erreur si cellule vide :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Function RightNum$(ByVal TX$)
    If TX = "" Then Exit Function
    TX = Trim$(Split(TX, "-")(UBound(Split(TX, "-"))))
    D$ = Right$(TX, 1):  If IsNumeric(D) Then D = "" Else TX = Left$(TX, Len(TX) - 1)
    L& = Len(TX)
 
    Do While C& < L And V& = 0
        C = C + 1:  V = Not IsNumeric(Right(TX, C))
    Loop
 
    If C + V > 0 Then RightNum = Right$(TX, C + V) & D
End Function

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé …

**Marc-L** · 31/12/2013, 18h13

Désolé pour les modifications à rallonge (optimisation …) mais je désirais terminer l'année en beauté !

**mercatog** · 31/12/2013, 21h43

Pour proposer ma grain de sel, les Regexp "mélangée" à StrReverse

Code :

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

1
2
3
4
5
6
7
8
9
10
Function ExtractLastNumber(ByVal Tmp As String) As String    'As Integer
Dim Rg As Object
 
Set Rg = CreateObject("VBScript.RegExp")
With Rg
    .Pattern = "(\D*)(\d+)(.*)"
    If .Test(Tmp) Then ExtractLastNumber = StrReverse(.Replace(StrReverse(Tmp), "$2"))
End With
Set Rg = Nothing
End Function

**boisgontierjacques** · 01/01/2014, 08h33

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
 
Function DernierNum(chaine)
  Set obj = CreateObject("vbscript.regexp")
  obj.Global = True
  obj.Pattern = "\d+"
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then DernierNum = Val(a(a.Count - 1)) Else DernierNum = 0
End Function

Jacques Boisgontier

**Marc-L** · 01/01/2014, 13h58

Ah la puissance des expressions régulières !

J'ai respecté l'énoncé du départ :

Envoyé par Timi493

b2-4a => extraire 4a

Comment auriez-vous fait en utilisant les expressions régulières ?

J'ai supposé de ne rien renvoyer si la cellule contient par exemple c3-b mais peut-être suis-je dans l'erreur …

Quoiqu'il en soit avec cinq méthodes, il a le choix !

**mercatog** · 01/01/2014, 15h02

Envoyé par Marc-L

Comment auriez-vous fait en utilisant les expressions régulières ?

Bonjour Marc et mes souhaits pour une nouvelle année pleine de bonnes choses et de paix

Pour ta question ci-haut

Code :

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

1
2
3
4
5
6
7
8
9
10
Function ExtractLastNumber(ByVal Tmp As String) As String
Dim Rg As Object
 
Set Rg = CreateObject("VBScript.RegExp")
With Rg
    .Pattern = "([A-Z:a-z]*)(\d+)(.*)"
    If .Test(Tmp) Then ExtractLastNumber = StrReverse(.Replace(StrReverse(Tmp), "$1$2"))
End With
Set Rg = Nothing
End Function

**Marc-L** · 01/01/2014, 15h09

Merci !

Dire que je les utilisais dans un autre langage (genre instruction GREP ?) mais cela fait des lustres !

Je devrais bien m'y coller en VBA (de plus il y a un tutoriel ici) mais avant d'avoir le réflexe, les vieilles habitudes …

**boisgontierjacques** · 01/01/2014, 18h17

Bonsoir,

RegExp est puissant mais n'est pas très rapide (60 fois plus lent pour la fonction étudiée)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Function NumChaineDernOccur(chaine)
  longueur = Len(chaine): If longueur = 0 Then NumChaineDernOccur = 0: Exit Function
  temp = ""
  p = longueur
  Do While Not IsNumeric(Mid(chaine, p, 1)) And p > 1
    p = p - 1
  Loop
  Do While IsNumeric(Mid(chaine, p, 1)) And p > 0
    temp = Mid(chaine, p, 1) & temp
    p = p - 1: If p = 0 Then Exit Do
  Loop
  NumChaineDernOccur = Val(temp)
End Function

Code :

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

1
2
3
4
5
6
7
8
 
Function DernierNum(chaine)
  Set obj = CreateObject("vbscript.regexp")
  obj.Global = True
  obj.Pattern = "\d+"
  Set a = obj.Execute(chaine)
  If a.Count > 0 Then DernierNum = Val(a(a.Count - 1)) Else DernierNum = 0
End Function

Jacques Boisgontier

**Marc-L** · 01/01/2014, 19h00

Merci Jacques de l'info !

Donc je peux rester satisfait de la mienne ! …

**mercatog** · 01/01/2014, 23h52

Pour la rapidité comme ça dans l'absolu des RegExp par rapport aux boucles sur chacun des caractères reste relative.

Il suffit de refaire le test avec des données comportant beaucoup de caractères à boucler (ici les valeurs numériques).

Bon dans la réalité de telles données sont peu probables.

extraire les chiffres d'une cellule [Toutes versions]

Excel

Discussions similaires

Partager

Partager