Extraction de chiffres depuis une cellule

Version imprimable

30/05/2013, 13h30
iIncoming

Extraction de chiffres depuis une cellule

Bonjour,

Ma cellule A7 contient le lieu de naissance de personnes sous la forme :
Ville - N° département - Pays

Exemples :
Rennes - 35 - France
Montpellier - 34 - France
Fort de France - 974 - Tahiti

Comment puis-je récupérer uniquement les chiffres contenus dans cette cellule et les recopier automatiquement dans la cellule qui contient le code s'il vous plaît ?

La recopie se fait d'une feuille à l'autre. Pour la recopie simple j'utilise déjà :

Code:

=SI('Feuill1'!$R$1<>"";'Feuill1'!$R$1;"")

Merci pour votre aide !

bonjour une idée à exploiter,
tu créer ta fonction de recherche des chiffre par exemple:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Function chiffre(mastring As Range) As String Dim Cible As String Cible = mastring.Value For i = 1 To Len(Cible) If IsNumeric(Mid(Cible, i, 1)) Then Nombre = Val(Mid(Cible, i, Len(Cible) - i + 1)) resultat = resultat & Nombre & vbLf i = i + Len(Str(Nombre)) - 1 End If Next chiffre = resultat End Function
code à copier dans un module.
la fonction s'appelle chiffre().

ensuite par exemple dans la cellule A1 tu met:

Code:

=chiffre(A7)

si ta chaine de caractère est en A7

attention dans la formule mettre uniquement une cellule pas une plage de cellule

c'est un exemple, il doit certainement y avoir beaucoup mieux

30/05/2013, 14h16
jfontaine

Bonjour,

Avec une formule

Code:

=GAUCHE(DROITE(A7;NBCAR(A7)-TROUVE("-";A7)-1);2)

ou en VBA

Code:

Val(Split(Range("A1").Value, "-")(1))

Bonjour,

Ou une autre fonction également :

Code:

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
 
Function IsolerLeDepartement(Cellule As Range)
 
Dim I As Integer
Dim PositionTiretDebut As Integer
Dim PositionTiretFin As Integer
 
 
  IsolerLeDepartement = 0
  PositionTiretDebut = 0
  PositionTiretFin = 0
 
  For I = 1 To Len(Cellule)
    If Mid(Cellule, I, 1) = "-" Then
        PositionTiretDebut = I
        Exit For
    End If
  Next I
 
  If PositionTiretDebut > 0 Then
 
      If PositionTiretDebut + 2 <= Len(Cellule) Then
         For I = PositionTiretDebut + 1 To Len(Cellule)
                If Mid(Cellule, I, 1) = "-" Then
                  PositionTiretFin = I
                  Exit For
                End If
        Next I
      End If
 
      IsolerLeDepartement = Mid(Cellule, PositionTiretDebut + 2, PositionTiretFin - (PositionTiretDebut + 2))
 
  End If
 
 
End Function

Cordialement.

Pour remplacer les infos de la colonne A par le Dept

Attention, l'exécution de code est sans retour, faire une sauvegarde avant
Code:

1 2 3 4 5 6 7 8 9 Sub MaProc() Dim i As Long For i = 1 To Range("A" & Rows.Count).End(xlUp).Row Range("A" & i).Value = Val(Split(Range("A" & i).Value, "-")(1)) Next i End Sub

30/05/2013, 16h22
iIncoming

Citation:

Envoyé par jfontaine

Bonjour,

Avec une formule

Code:

=GAUCHE(DROITE(A7;NBCAR(A7)-TROUVE("-";A7)-1);2)

ou en VBA

Code:

Val(Split(Range("A1").Value, "-")(1))

Merci beaucoup ! Ça marche bien. Et c'est la fonction formule qui m'intéresse.
En revanche, petit problème :

Chamonix Mont-Blanc - 74 - France... C'est "la" qui se recopie au lieu du 74... Comment corriger ça ?

Une petit amélioration, mais il ne faudrait pas que le pays comporte aussi un trait d'union

Code:

1
2
3
4
5
6
7
Dim i As Long
Dim str() As String
 
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    str = Split(Range("A" & i).Value, "-")
    Range("A" & i).Value = Val(str(UBound(str) - 1))
Next i

30/05/2013, 16h43
iIncoming

Merci mile fois... Mais sauriez vous m'indiquer le code non pas pour une macro mais pour une formule s'il vous plaît ?
30/05/2013, 16h58
jfontaine

vu la spécif des localités, utilise le code VBA pour faire une fonction que tu utilisera comme formule
31/05/2013, 08h19
iIncoming

Merci pour la réponse. Dommage que je ne puisse pas le faire via une formule. D'ailleurs comment puis-je appeler cette macro et l'affaire travailler dans ma cellule ?

Enfin, je suis embêté car effectivement certains pays contiennent des tirets comme Pays-Bas...

Bonjour,

Ci-dessous, mon code modifié pour répondre au cas où la première partie comporte un ou plusieurs tirets. Le code ne fonctionne pas si la dernière partie comporte également un tiret.

Code:

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Function IsolerLeDepartement(Cellule As Range)
 
Dim I As Integer
Dim PositionTiretDebut As Integer
Dim PositionTiretFin As Integer
Dim NombreDeTirets As Integer
 
 
  IsolerLeDepartement = 0
  PositionTiretDebut = 0
  PositionTiretFin = 0
  NombreDeTirets = 0
 
  For I = 1 To Len(Cellule)
    If Mid(Cellule, I, 1) = "-" Then
        NombreDeTirets = NombreDeTirets + 1
    End If
  Next I
 
 Select Case NombreDeTirets
          Case Is <= 2
                    For I = 1 To Len(Cellule)
                       If Mid(Cellule, I, 1) = "-" Then
                           PositionTiretDebut = I
                           Exit For
                       End If
                     Next I
 
                     If PositionTiretDebut > 0 Then
 
                         If PositionTiretDebut + 2 <= Len(Cellule) Then
                            For I = PositionTiretDebut + 1 To Len(Cellule)
                                   If Mid(Cellule, I, 1) = "-" Then
                                     PositionTiretFin = I
                                     Exit For
                                   End If
                           Next I
                         End If
 
                         IsolerLeDepartement = Mid(Cellule, PositionTiretDebut + 2, PositionTiretFin - (PositionTiretDebut + 2))
 
                     End If
 
          Case Is > 2
 
                     For I = Len(Cellule) To 1 Step -1
                        If Mid(Cellule, I, 1) = "-" Then
                            PositionTiretFin = I
                            Exit For
                        End If
                      Next I
 
                      If PositionTiretFin > 0 Then
                             For I = PositionTiretFin - 1 To 1 Step -1
                                    If Mid(Cellule, I, 1) = "-" Then
                                      PositionTiretDebut = I
                                      Exit For
                                    End If
                            Next I
                            IsolerLeDepartement = Mid(Cellule, PositionTiretDebut + 2, PositionTiretFin - (PositionTiretDebut + 2))
                      End If
 
 End Select
 
 
End Function

Ce code est à mettre dans un module standard de votre fichier.

Pour appeler la fonction, il suffit de la placer dans une cellule et de pointer la cellule contenant le texte. Par exemple :

Code:

=IsolerLeDepartement(A5)

Cordialement.

1 pièce(s) jointe(s)

salut à tous,

Le code que j'ai mis dans la fonction dans mon premier post vient du tuto de Silkyroad sur les manipulations de chaine de caractères.

Ici Peu importe les caractères le code ne cherche que les chiffres et retourne le bon résultat

donc il faut que dans l'éditeur vba (ALT+F11):
=> tu insères un module => Insertion=>Module
=> dans le module tu colles ce code (ou autre):
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Function departement(mastring As Range) As String Dim Cible As String Cible = mastring.Value For i = 1 To Len(Cible) If IsNumeric(Mid(Cible, i, 1)) Then Nombre = Val(Mid(Cible, i, Len(Cible) - i + 1)) resultat = resultat & Nombre & vbLf i = i + Len(Str(Nombre)) - 1 End If Next departement = resultat End Function
ensuite si ta référence est dans la cellule A1 et que tu veux mettre juste le département dans le cellule B1 alors dans la cellule B1 tu met cette formule qui appelle ta fonction perso:

Code:

=departement(A1)

tu auras en B1 le N° du département.

Je te met un exemple

Ci dessous le code dans une fonction avec recherche du departement meme si - dans localité et pays

A mettre dans un module
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Function TrouveDept(Cellule As Range) As Integer Dim str() As String Dim j As Integer Dim Resultat As Integer str = Split(Cellule.Value, "-") For j = 0 To UBound(str) If IsNumeric(str(j)) Then Resultat = Val(str(j)) Next j TrouveDept = Resultat End Function
A utiliser en formule

Code:

=trouvedept(A1)

31/05/2013, 21h19
iIncoming

Citation:

Envoyé par jfontaine

A utiliser en formule

Code:

=trouvedept(A1)

J'ai essayé de faire fonctionner ceci mais je suis confronté à un petit problème.
Les numéros du département que je souhaite extraire en utilisant =trouvedept se trouvent sur une autre feuille !

Je suis sur la "Feuill1" (c'est elle qui contient =trouvedept) et mes départements se trouvent sur "Feuill2" et visiblement je ne parviens pas à faire fonctionner le tout...
01/06/2013, 17h01
Theze
Bonjour,

Si ta valeur n'est pas sur la même feuille que la fonction, il te faut lui indiquer la feuille où se situe la cellule à prendre de compte donc :
Code:

1 2 =trouvedept(Feuil2!A1)
A voir l'orthographe du nom "Feuill2" ou "Feuil2" !

Hervé.

Bonjour,

Ce code fonctionne à merveille.
Maintenant, lorsque j'utilise mon module pour extraire le département :

Code:

=Departement('XXX VIERGE'!$A$7)

Et lorsque la feuille 'XXX VIERGE' dans la cellule A7 contient uniquement un tiret : -
Je souhaiterais que ce code m'affiche bel et bien le tiret et non pas un 0.

Ci-dessous, le code dans un module qui extrait le département de la phrase en A7 :
Chamonix Mont-Blanc - 74 - France
Code:

1 2 3 4 5 6 7 8 9 10 Function Departement(Cellule As Range) As Integer Dim str() As String Dim j As Integer Dim Resultat As Integer str = Split(Cellule.Value, "-") For j = 0 To UBound(str) If IsNumeric(str(j)) Then Resultat = Val(str(j)) Next j Departement = Resultat End Function
Avez-vous une idée ?

Merci pour votre aide,
iIncoming

Bonsoir,
essayes comme ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function Departement(Cellule As Range) As Integer
    Dim str() As String
    Dim j As Integer
    Dim Resultat As Integer
    If Cellule <> "-" Then
      str = Split(Cellule.Value, "-")
        For j = 0 To UBound(str)
            If IsNumeric(str(j)) Then Resultat = Val(str(j))
        Next j
    Else
      Resultat = Cellule
    End If
Departement = Resultat
End Function

28/06/2013, 19h16
mercatog
Bonjour Dominique, iIncoming

Il faudra changer le type de la fonction et de la variable Resultat en String
dans le code proposé par Dominique
Code:

1 2 Function Departement(Cellule As Range) As String Dim Resultat As String, Str() As String
28/06/2013, 21h27
iIncoming

Bonsoir,

Ca fonctionne mais il faut que j'enlève le

Code:

, Str() As String

Merci !