Extraire des nombres dans une chaine de caractère

**fxfxfx** · 24/05/2013, 19h01

Bonjour, je cherche à extraire des nombres contenus dans diverses chaines de caractère. Un exemple sera plus compréhensible

Chaine _______________________________Resultat souhaité

Studette 9 m²__________________________9
Studio 2 pièces 39 m²____________________39
Chambre de service 5 m² ________________ 5
Appartement 3 pièces 65 m²_______________ 65
Appart 2 pièces 45 m²___________________45

Les chaines de caractères finissent toujours par "m²" et mais les chaines de caractères avant la surface de l'appartement sont aléatoires (studios, studio, chambre, appartement, appart...)

J'avais réalisé le code suivant

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
Sub Bouton1_Clic()
    Dim C As Range, Plage As Range, Txt As String, X As Variant
    With Sheets("Feuil1")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Feuil2")
        For Each C In Plage
            Txt = ""
            For i = 1 To C.Characters.Count
                X = C.Characters(i, 1).Text
                If X = "," Or (X >= 0 And X <= 9) Then
                    Txt = Txt & X
                End If
            Next
            If Txt <> "" Then
                    .Cells(C.Row, 1).Value = CDbl(Txt)
                End If
        Next C
    End With
End Sub

Mais elle ne donne pas le bon résultat...
Par exemple pour "Appartement 3 pièces 65 m² ", cela renvoie 365 et non 65...

Merci beaucoup de votre aide !!

Bonne journée

Invité · 24/05/2013, 20h38

Ci joint un code fonctionnel. Cependant la surface doit toujours être le dernier nombre.

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
Option Explicit
Option Base 1
 
Sub Bouton1_Clic()
Dim C As Range, Plage As Range
Dim i as Integer, j As Integer
Dim strCible As String
Dim intVal() As Integer
 
    With Sheets("Feuil1")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
    End With
 
    With Sheets("Feuil2")
 
        For Each C In Plage.Cells
            strCible = C.Value
            strCible = Replace(strCible, ",", ".")
            strCible = Replace(strCible, " ", "x")
 
            j = 0
            ReDim intVal(1)
            For i = 1 To Len(strCible)
                If IsNumeric(Mid(strCible, i, 1)) Then
                    j = j + 1
                    ReDim Preserve intVal(j)
                    intVal(j) = Val(Mid(strCible, i, Len(strCible) - i + 1))
                    i = i + Len(Str(intVal(j))) - 1
                End If
            Next i
 
            .Cells(C.Row, 1).Value = CDbl(intVal(UBound(intVal)))
 
        Next C
    End With
End Sub

http://silkyroad.developpez.com/VBA/...racteres/#LI-P

**Marc-L** · 24/05/2013, 20h47

Bonjour,

p'tite variante renvoyant la valeur numérique précédant l'unité :

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
Function ExtraitNum(Texte, Unité) As Long
    P& = InStrRev(Texte, Unité)
 
    If P& Then
        P& = InStrRev(Texte, " ", P& - 1)
        If P& Then ExtraitNum = Val(Mid(Texte, P&))
    End If
End Function
 
 
Sub Demo()
    For Each Lot In Split("Studette 9 m²;Studio 2 pièces 39 m²;Chambre de service 5 m²", ";")
        M$ = M$ & Lot & "  __________  " & ExtraitNum(Lot, " m²") & vbLf & vbLf
    Next
        MsgBox M$
End Sub

_______________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**BlueMonkey** · 24/05/2013, 20h52

Bonsoir,
Une autre variante

S'il y a toujours un espace entre la surface et m², et que l'espace n'est pas utilisé comme séparateur de millier,
tu peux essayer, la fonction split avec l'espace comme séparateur d'élément.
Puis en considérant que l'avant dernier éléments séparé par un espace est toujours la surface :

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
Option Explicit
 
Sub Bouton1_Clic()
    Dim c As Range
    Dim Plage As Range
    With Sheets("Feuil1")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
    End With
 
    Dim vals() As String
    With Sheets("Feuil2")
        For Each c In Plage
            vals = Split(c, " ")
            If UBound(vals) > 1 Then
                .Cells(c.Row, 1) = vals(UBound(vals) - 1)
            End If
        Next c
    End With
 
End Sub

**fxfxfx** · 24/05/2013, 21h04

@ BlueMonkey
Merci pour ton code ! cela fonctionne sur une cellule.... pas sur une plage de cellule.. je me trompe peut etre mais je n'ai pas reussi...

**BlueMonkey** · 24/05/2013, 21h15

La boucle For Each c In Plage fait que le code boucle sur toute les cellules de la plage.

je me trompe peut etre mais je n'ai pas reussi...

Pas réussi à quoi ?
Lorsque tu exécute le code en pas à pas, ça ne boucle pas sur toutes les cellules de la plage définie ?

**fxfxfx** · 24/05/2013, 21h32

En fait je pense avoir trouvé le problème...
Dans mes données à traiter, il y a un espace après m²...

mes données sont de cette forme (sans les guillements)
"Appartement 3 pièces 55 m² "

et j'ai aussi des données de la forme "Appartement 3 pièces 55,4 m² "

**BlueMonkey** · 24/05/2013, 21h55

et j'ai aussi des données de la forme "Appartement 3 pièces 55,4 m² "

Du moment que le prix ne comporte pas d'espace, il n'y a pas de problème.

Dans mes données à traiter, il y a un espace après m²...

Dans ce cas remplace la ligne 15 du code précédent

Code :

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

.Cells(c.Row, 1) = vals(UBound(vals) - 1)

par

Code :

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

.Cells(c.Row, 1) = vals(UBound(vals) - 2)

**Marc-L** · 24/05/2013, 23h24

Nouvelle fonction gérant aussi bien les valeurs décimales avec une virgule ou un point comme séparateur décimal,
peu importe s'il y a un espace après m², voir la procédure Demo :

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
Function ExtraitM²(Texte) As Double
    T$ = Application.Trim(Texte)
    F& = InStrRev(T$, " m²")
 
    If F& Then
        D& = InStrRev(T$, " ", F& - 1)
 
        If D& Then
            T$ = Mid$(T$, D& + 1, F& - D& - 1)
             If IsNumeric(T$) Then ExtraitM² = CDbl(T$) Else _
            If InStr(T$, ".") Then ExtraitM² = Val(T$)
        End If
    End If
End Function
 
Sub Demo()
    For Each Lot In Array("    Studette     9.2    m²    ", "Appart 3 pièces 55,4 m² ")
        M$ = M$ & Lot & "  __________  " & ExtraitM²(Lot) & vbLf & vbLf
    Next
 
    MsgBox M$
End Sub

_______________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

______________________________
Dieu ordonna à David de guetter … et David Guetta !

**fxfxfx** · 25/05/2013, 22h21

Merci beaucoup! J'ai opté pour la solution de bluemonkey qui fonctionne parfaitement ! (J'ai juste rajouter un *1 à la ligne 15 car les surfaces à virgule étaient considéré comme du texte sinon)

Après je me suis peut être mal exprimé, mais il n'y a pas de ___ dans mes données.. C'était pour mettre en forme ma question que j'ai utilisé les __

Merci

**BlueMonkey** · 25/05/2013, 23h21

Bonsoir,

Content que ça fonctionne comme tu veux

.

(J'ai juste rajouter un *1 à la ligne 15 car les surfaces à virgule étaient considéré comme du texte sinon)

Une autre solution pour garantir la conversion sous une forme de nombre est d'utiliser la fonction CDbl(...) sur la ligne 15 :

Code :

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

.Cells(c.Row, 1) = CDbl(vals(UBound(vals) - 2))

Après je me suis peut être mal exprimé, mais il n'y a pas de ___ dans mes données..

Les données d'entrée pour le traitement via le code de Marc-L et de vcottineau ne présentait pas de caractère _
Ils n'utilisaient les _ que pour remettre en forme le résultat comme tu l'as toi même présenté.

Il ne reste plus qu'a passer le sujet en

A+

**fxfxfx** · 27/05/2013, 00h33

Merci beaucoup..
c'est presque résolu, car j'ai un soucis encore.. je viens de me rendre compte que parfois j'avais des données où c’était juste par exemple "Maison 4 pièces", du coup ca renvoie 4 !
est-ce que le code est adaptable pour résoudre ce problème ?

**Marc-L** · 27/05/2013, 01h48

C'est limite à dégoûter de donner des réponses car, malgré l'explication de BlueMonkey, tu n'as même pas daigné tester
notamment ma dernière fonction car cela t'aurait évité de poster une nouvelle idiotie ‼ Ton souci est donc déjà résolu …

Au passage, j'en profite pour remercier celui ayant testé, lui, puis ayant voté en ma faveur !

______________________________________________________________________
Quand on est mort, on ne sait pas qu'on est mort, c'est pour les autres que c'est difficile … Quand on est con, c'est pareil ‼

**fxfxfx** · 27/05/2013, 10h44

j'ai regardé ta fonction, mais je n'arrive pas à l'adapter sur des cellules...
je suis pas un expert en excel comme toi désolé... c'est d'ailleurs pour ca que je viens sur ce forum !

je veux juste dans une colonne le texte brut, et dans une autre colonne la surface...

**BlueMonkey** · 27/05/2013, 11h41

Bonjour,

Je viens de me rendre compte que parfois j'avais des données où c’était juste par exemple "Maison 4 pièces", du coup ca renvoie 4 !

Le code suivant corrige ce cas particulier sur la base de mon code. (rien n'est inscrit dans le cas où la ligne ne contient pas m²)

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
Option Explicit
Sub Bouton1_Clic()
    Dim c As Range
    Dim Plage As Range
    With Sheets("Feuil1")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
    End With
 
    Dim vals() As String
    With Sheets("Feuil2")
        For Each c In Plage
            vals = Split(c, " ")
            Dim col As Integer
            For col = UBound(vals) To 0 Step -1
                If vals(col) = "m²" Then
                    .Cells(c.Row, 1) = CDbl(vals(col - 1))
                    Exit For
                End If
            Next col
        Next c
    End With
 
End Sub

Envoyé par Marc-L

Au passage, j'en profite pour remercier celui ayant testé, lui, puis ayant voté en ma faveur !

De rien

. Même si je ne suis pas parti sur la même approche,
je trouve normal de plussoyer une réponse qui fait le boulot (voir plus).

Envoyé par fxfxfx

j'ai regardé ta fonction, mais je n'arrive pas à l'adapter sur des cellules...

Pour l'exemple, le même code adapté pour utiliser la code de Marc-L.

(Tout le traitement particulier est fait dans la fonction ExtraitM²)

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
Sub Bouton1_Clic()
    Dim c As Range
    Dim Plage As Range
    With Sheets("Feuil1")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
    End With
 
    With Sheets("Feuil2")
        For Each c In Plage
            .Cells(c.Row, 1) = ExtraitM²(c)
        Next c
    End With
 
End Sub
 
 
Function ExtraitM²(Texte) As Double
    T$ = Application.Trim(Texte)
    F& = InStrRev(T$, " m²")
 
    If F& Then
        D& = InStrRev(T$, " ", F& - 1)
 
        If D& Then
            T$ = Mid$(T$, D& + 1, F& - D& - 1)
             If IsNumeric(T$) Then ExtraitM² = CDbl(T$) Else _
            If InStr(T$, ".") Then ExtraitM² = Val(T$)
        End If
    End If
End Function

A+

Extraire des nombres dans une chaine de caractère

Macros et VBA Excel

Discussions similaires

Partager

Partager