Discussion :

[Alan91]

Bonjour,

Dans un très long tableau, j'ai besoin de supprimer tout les caractères des cellules sur une colonne à l'exception des chiffres qui sont regroupés par 5 (longueur de 5).
Par exemple dans les cellules j'ai :

bateau-70 max [mer 54430] geo

Et je souhaite garder seulement le code de 5 chiffres donc : 54430
Et cela pour la colonne entière. J'ai déjà trouvé une macro qui supprimait tout sauf les chiffres mais j'obtenais 7054430 donc c'est pas bon.
Merci pour votre aide.

Alan

[Marc-L]

Bonjour, bonjour,

consulter l'aide intégrée de VBA concernant les fonctions Len, Split et Val ou IsNumeric …

[Alan91]

Merci mais je suis très nul avec les macros. Voici la macro que j'ai trouvée, il suffit peut être de rajouter 1 ou 2 lignes pour la longueur de 5.

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
Sub essai()
Dim val1 As String
Dim i As Long
Dim cell As Range
Dim oldCalculation As Variant '
Dim reponse As Variant
 
oldCalculation = Application.Calculation
Application.Calculation = xlCalculationManual
 
'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
On Error GoTo suite
Set reponse = Application.InputBox(Prompt:="Veuillez sélectionner la zone à convertir", Type:=8, Default:="")
 
Application.ScreenUpdating = False 'gele l'ecran
Application.EnableEvents = False
Application.DisplayAlerts = False 'interdit les messages d'avertissements
 
For Each cell In reponse
If cell = "" Then
Else
val1 = ""
For i = 1 To Len(cell)
If Asc(Mid(cell, i, 1)) > 47 And Asc(Mid(cell, i, 1)) < 59 Then val1 = val1 & Mid(cell, i, 1)
Next
cell = val1
End If
Next cell

[defluc]

= Right("705443", 4)

[MarcelG]

Bonjour Alan,

Est-ce que tous les enregistrements comportent les "codes" compris entre 2 crochets, plus précisément se présentent-ils sous la forme

[xxx NNNNN] (si tu veux extraire "NNNNN")

[Alan91]

Bonjour Marcel,

Non pas du tout, selon les cellules, il se peut qu'il y ait déjà le code de 5 chiffres ou juste des lettres avec comme LEV-55430

[defluc]

Bonjour,

Comme ta source fonctionne, suffit de la compléter par la fonction Right comme dit plus haut.

Code :

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

1
2
3
4
For i = 1 To Len(Cell)
  If Asc(Mid(Cell, i, 1)) > 47 And Asc(Mid(Cell, i, 1)) < 59 Then val1 = val1 & Mid(Cell, i, 1)
Next
val1 = Right(val1, 5)

[MarcelG]

Salut,

Par défaut, j'ai considéré que les codes figuraient dans la 1ère colonne de la 1ère feuille et débutaient à la 1ère ligne
Pour contrôle, le ccode est inscrit à la colonne suivante.
Donc : à adapter.

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
Option Explicit
 
Public Sub essai_extrac()
Dim derlign As Long
Dim i As Long
Dim j As Byte
Dim lecode As Long
 
Application.ScreenUpdating = False
 
With Worksheets(1)
        'recherche de la dernière cellule informée de la 1ère colonne
        'celle où se situent les valeurs
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        'balayage de la 1ère ligne jusqu'à la dernière
        For i = 1 To derlign
                With .Cells(i, 1)
                        'balayage de tous les caractères de la cellule
                        For j = 1 To Len(.Value)
                                'Test si 5 valeurs successives sont numériques
                                If IsNumeric(Mid(.Value, j, 1)) _
                                        And IsNumeric(Mid(.Value, j + 1, 1)) _
                                        And IsNumeric(Mid(.Value, j + 2, 1)) _
                                        And IsNumeric(Mid(.Value, j + 3, 1)) _
                                        And IsNumeric(Mid(.Value, j + 4, 1)) _
                                        And Not IsNumeric(Mid(.Value, j + 5, 1)) Then
                                                'concaténation des 5 caractères
                                                lecode = Mid(.Value, j, 1) * 10000 + Mid(.Value, j + 1, 1) * 1000 + Mid(.Value, j + 2, 1) * 100 + Mid(.Value, j + 3, 1) * 10 + Mid(.Value, j + 4, 1) * 1
                                                'inscription du code dans la colonne suivante
                                                .Offset(0, 1).Value = lecode
                                                Exit For
                                End If
                        Next j
                End With
        Next i
End With
 
End Sub

A étudier ligne par ligne.
Et revenir si nécessaire pour toute question.