Discussion :

[sylvaindavid2]

Bonjour à tous

Pour commencer, merci pour ce forum et les nombreux sujets auxquels vous avez répondus, ils m’ont été très souvent d’une grande aide.

Alors, je voudrais faire une macro pour simplifier une suite de chiffres qui est dans une cellule et je n’arrive pas à trouver une solution.
Je m’explique, dans une cellule, exemple "A1" j’ai une suite de chiffres « 1, 2, 3, 5, 6, 9, 11, 12 » et je voudrais supprimer les numéros que se suivent et mettre une flèche entre : « 1->6, 9, 11->12 »
Avez-vous une idée ?

Merci pour votre aide !

Bonne journée

[BENNASR]

bonjour
je sais pas si ça va t'aider au non mais pour scinder ta chaîne de caractère sur plusieurs colonne tu peux faire avec ça :

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
Sub extractiondeschiffres()
    Dim Tableau() As String
    Dim i As Integer
    Dim j As Integer
 
    With Sheets("feuil1")
    Tableau = Split(.Cells(1, 1), ",")
    j = 2
    For i = 0 To UBound(Tableau)
        Debug.Print Tableau(i)
         .Cells(1, j) = Tableau(i)
         j = j + 1
    Next i
    End With
End Sub

[sylvaindavid2]

Bonjour BENNASR

Merci pour ton aide, j'ai déjà fait une macro qui ressemble à la tienne mais je voulais une macro plus simple et en évitent d’écrire sur ma feuille. Je préférait utiliser des variables.

Merci!

[BENNASR]

Bonsoir
j'ai bricolé ça

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 test()
 
Dim Tableau() As String
    Dim i As Integer
    Dim j As Integer
    Dim x
    Dim c
    With Sheets("feuil1")
    Tableau = Split(.Cells(1, 1), ",")
    j = 2
    For i = 0 To UBound(Tableau)
        Debug.Print Tableau(i)
    Next i
    End With
 
 
Cells(1, 2) = ""
Dim L As Integer
 
c = Tableau(0)
On Error Resume Next
For L = 0 To UBound(Tableau)
If Tableau(L + 1) - Tableau(L) <> 1 Then
x = Tableau(L)
Cells(1, 2) = Cells(1, 2) & " , " & c & "->" & x
c = Tableau(L + 1)
End If
Next L
 
End Sub

[eriiic]

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
15
16
17
18
Sub test()
    Debug.Print regroup("1, 2, 3, 5, 6, 9, 11, 12")
End Sub
 
Function regroup(s As String) As String
    Dim pl As Range, i As Long, tmp, tmp2
    If s = "" Then regroup = "": Exit Function
    tmp = Split(Application.Trim(s), ",")
    For i = 0 To UBound(tmp)
        If pl Is Nothing Then Set pl = Rows(tmp(i)) Else Set pl = Union(pl, Rows(tmp(i)))
    Next i
    tmp = Split(pl.Address(False, False), ",")
    For i = 0 To UBound(tmp)
        tmp2 = Split(tmp(i), ":")
        If tmp2(0) = tmp2(1) Then tmp(i) = tmp2(0) Else tmp(i) = Join(tmp2, "->")
    Next i
    regroup = Join(tmp, ", ")
End Function

fonction à mettre dans un module Standard si tu veux l'appeler depuis une feuille.
Je ne teste pas si la chaine passée est bien conforme à ce qui est attendu. Ajouter les tests si besoin.
eric

[sylvaindavid2]

BENNASR et Eriiic

Je vous remercie beaucoup pour votre aide!!
J'ai repris la macro d'Eriiic, elle correspondait parfaitement à ce dont j'avais besoin
J'ai beau venir souvent sur ce forum, vous m'impressionnez toujours autant par votre rapidité et vos solutions!!

Bon Week-ends