Discussion :

[nivk-539]

Bonjour à tous,

J'ai un problème que je n'arrive pas à résoudre concernant la manipulation de chaines de caractères.
J'ai par exemple dans ma cellule A3 une chaine comme ceci : name-1-2-3-/-/-6-7-8-/-X-11-12-13-14-X-16-/-/-/
J'extrait tout d'abord que la partie "1-2-3-/-/-6-7-8-/-X-/-12-13-14-X-16" avec Mid (Range("A3"),6).
Ensuite je supprime les derniers caractères ("-/") avec ce code :

Code :

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

1
2
3
4
5
6
7
Sub supprimer()
 
Do While Right(Range("A3"), 2) = "-/"
        Range("A3") = Left(Range("A3"), Len(Range("A3")) - 2)
Loop
 
End Sub

Par contre ce que j'aimerai faire maintenant, c'est d'extraire tout d'abord les parties gauches et droites après chaque et avant chaque "-/-" et "-X-", c'est à dire de ne garder que "1-2-3", "6-7-8" , "12-13-14" et "16". Puis dans ces plages de caractères, le but serait de supprimer les chiffres au milieu afin d'obtenir au final => name-3-/-/-6-8-/-X-12-14-X-16. Du coup en effet le 1 ne doit pas être gardé car c'est le premier chiffre de la série. Par contre si je n'ai que "name-1" au début, je ne souhaite pas le supprimer... J'avoue que je ne vois pas quelle serait la meilleure logique pour le faire ... Voici un fichier avec différents cas dans la feuille 1 et ce que je souhaiterai avoir dans la feuille2

[BENNASR]

Bonsoir
voir cette discussion et surtout une bonne fonction personnalisée développée par ERIC (bjr au passage)

https://www.developpez.net/forums/d1...uite-chiffres/

[patricktoulon]

Bonjouir

Code :

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

1
2
3
4
5
6
7
8
Sub test()
chaine = "name-1-2-3-/-/-6-7-8-/-X-11-12-13-14-X-16-/-/-/"
chaine = Split(chaine, "name-")(1)
For i = 1 To Len(chaine)
texte = texte & IIf(IsNumeric(Mid(chaine, i, 1)), Mid(chaine, i, 1), " ")
Next
MsgBox Application.Trim(texte)
End Sub

[nivk-539]

Merci à vous 2,

BENNASR ta solution me convient mieux du coup je l'ai adapté à mon cas mais il me reste un petit problème que je n'arrive pas à résoudre.
Je te laisse prendre connaissance du fichier avec mon cas

[nivk-539]

c'est bon j'ai trouvé !

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub test()
Dim posX, posSlash, posFin
tableau = Range("a1", Range("a" & Rows.Count).End(xlUp))
 
For i = LBound(tableau, 1) To UBound(tableau, 1)
    texte = ""
    chaine = ""
    indice = 0
    nom = Left(tableau(i, 1), InStr(1, tableau(i, 1), "-") - 1)
    curseur = Len(nom) + 1
 
    Do
    If Not Mid(tableau(i, 1), curseur) Like "*#*" Then Exit Do 'vérifie qu'il reste des nombres à mettre
    'calcul de la position de fin de la chaine à traiter
    posX = InStr(curseur, tableau(i, 1), "-X-")
    posSlash = InStr(curseur, tableau(i, 1), "-/-")
    If posX > posSlash Or posX = 0 Then
        posFin = posSlash
    Else
        posFin = posX
    End If
 
    If posFin = 0 Then Exit Do
    texte = texte & IIf(chaine = "-/", "-/", "")
 
    'changement de la variable chaine
    If posFin = posSlash Then
        chaine = "-/"
    Else
        chaine = "-X"
    End If
 
    nombredep = ""
    nombrefin = ""
    carpred = ""
 
    'parcours de tous les caractères entre le curseur et la fin
    For h = curseur To posFin - 1
        car = Mid(tableau(i, 1), h, 1)
        If IsNumeric(car) Then
            If IsNumeric(carpred) Then
                If nombrefin <> "" Then
                    nombrefin = nombrefin & car
                Else
                    nombredep = nombredep & car
                End If
            Else
                If nombredep <> "" Then
                    nombrefin = car
                Else
                    nombredep = car
                End If
            End If
        End If
        carpred = car
    Next h
 
    'enregistrement des nombres dans la variable texte
    If indice = 0 Then
        texte = "-" & IIf(nombrefin <> "", nombrefin, nombredep)
    Else
        texte = texte & IIf(nombredep <> "", "-" & nombredep, "") & IIf(nombrefin <> "", "-" & nombrefin, "") _
 
    End If
    texte = texte & IIf(chaine = "-X", "-X", "")
 
    'incrémentations
    curseur = posFin + Len(chaine)
    indice = indice + 1
    Loop
 
    tableau(i, 1) = nom & texte
Next i
Range("c1", "c" & UBound(tableau, 1)) = tableau
End Sub

merci quand même

[nivk-539]

Si ça intéresse des gens, j'ai adapté mon code pour n'avoir que le Range("A1") de pris en compte :

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Sub test()
 
Dim posX, posSlash, posFin
Dim rng As Range
Dim MaChaine As String, i As Long
Dim Insert As String
 
Set rng = Sheets(1).Range("A1")
 
If Not rng.Value = "name-1" Then
 
    If Right(rng.Value, 4) Like "-/-/" Then
 
            texte = ""
            chaine = ""
            indice = 0
            nom = Left(rng, InStr(1, rng, "-") - 1)
            curseur = Len(nom) + 1
 
            Do
            If Not Mid(rng, curseur) Like "*#*" Then Exit Do 'vérifie qu'il reste des nombres à mettre
            'calcul de la position de fin de la chaine à traiter
            posX = InStr(curseur, rng, "-X-")
            posSlash = InStr(curseur, rng, "-/-")
            If posX > posSlash Or posX = 0 Then
                posFin = posSlash
            Else
                posFin = posX
            End If
 
            If posFin = 0 Then Exit Do
            texte = texte & IIf(chaine = "-/", "-/", "")
 
            'changement de la variable chaine
            If posFin = posSlash Then
                chaine = "-/"
            Else
                chaine = "-X"
            End If
 
            nombredep = ""
            nombrefin = ""
            carpred = ""
 
            'parcours de tous les caractères entre le curseur et la fin
            For h = curseur To posFin - 1
                car = Mid(rng, h, 1)
                If IsNumeric(car) Then
                    If IsNumeric(carpred) Then
                        If nombrefin <> "" Then
                            nombrefin = nombrefin & car
                        Else
                            nombredep = nombredep & car
                        End If
                    Else
                        If nombredep <> "" Then
                            nombrefin = car
                        Else
                            nombredep = car
                        End If
                    End If
                End If
                carpred = car
            Next h
 
            'enregistrement des nombres dans la variable texte
            If indice = 0 Then
                texte = "-" & IIf(nombrefin <> "", nombrefin, nombredep)
            Else
                texte = texte & IIf(nombredep <> "", "-" & nombredep, "") & IIf(nombrefin <> "", "-" & nombrefin, "") _
 
            End If
            texte = texte & IIf(chaine = "-X", "-X", "")
 
            'incrémentations
            curseur = posFin + Len(chaine)
            indice = indice + 1
            Loop
 
            rng = nom & texte
 
    ElseIf Not Right(rng.Value, 4) Like "-/-/" Then
 
 
        rng.Value = rng.Value & Left(MaChaine, 2) & "-/-/"
 
            texte = ""
            chaine = ""
            indice = 0
            nom = Left(rng, InStr(1, rng, "-") - 1)
            curseur = Len(nom) + 1
 
            Do
            If Not Mid(rng, curseur) Like "*#*" Then Exit Do 'vérifie qu'il reste des nombres à mettre
            'calcul de la position de fin de la chaine à traiter
            posX = InStr(curseur, rng, "-X-")
            posSlash = InStr(curseur, rng, "-/-")
            If posX > posSlash Or posX = 0 Then
                posFin = posSlash
            Else
                posFin = posX
            End If
 
            If posFin = 0 Then Exit Do
            texte = texte & IIf(chaine = "-/", "-/", "")
 
            'changement de la variable chaine
            If posFin = posSlash Then
                chaine = "-/"
            Else
                chaine = "-X"
            End If
 
            nombredep = ""
            nombrefin = ""
            carpred = ""
 
            'parcours de tous les caractères entre le curseur et la fin
            For h = curseur To posFin - 1
                car = Mid(rng, h, 1)
                If IsNumeric(car) Then
                    If IsNumeric(carpred) Then
                        If nombrefin <> "" Then
                            nombrefin = nombrefin & car
                        Else
                            nombredep = nombredep & car
                        End If
                    Else
                        If nombredep <> "" Then
                            nombrefin = car
                        Else
                            nombredep = car
                        End If
                    End If
                End If
                carpred = car
            Next h
 
            'enregistrement des nombres dans la variable texte
            If indice = 0 Then
                texte = "-" & IIf(nombrefin <> "", nombrefin, nombredep)
            Else
                texte = texte & IIf(nombredep <> "", "-" & nombredep, "") & IIf(nombrefin <> "", "-" & nombrefin, "") _
 
            End If
            texte = texte & IIf(chaine = "-X", "-X", "")
 
            'incrémentations
            curseur = posFin + Len(chaine)
            indice = indice + 1
            Loop
 
            rng = nom & texte
 
 
        End If
Else
 
    Exit Sub
 
End If
 
 
End Sub