Discussion :

[Arnal58]

Bonjour à tous.

Je suis confronté à un problème dont je ne trouve pas la solution sur les forums.

Problème : j'ai créé un fichier que mes utilisateurs viennent remplir (un tableau avec plusieurs données) dont une qui peut contenir 2 voire 3 chaines de caractères (noms avec espaces) séparées par une chaîne composée d'un espace, d'un signe "+" et d'un autre espace.
J'ai un sub qui vient lire la colonne et me copier les données dans un autre onglet ("Temp"), supprimer les doublons et les trier par ordre alphabétique.

Ce pour quoi je tourne en rond, c'est que je voudrais séparer ces chaines de caractère pour les copier unitairement dans des cellules à part. Dans le fichier exemple, j'ai mis l'attendu dans la colonne E de l'onglet Temp.

Donc, un gros HEEELLLLPPPP !!!! Merci d'avance à tous

Séparation des chaines de caractère.xlsm

[Fab_de_chez_PERFORM]

Bonjour
je ferais un truc comme cela :

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
Sub test()
 
Dim rng As Range: Set rng = Application.Range("Feuil1!A2:A16")
Dim cel As Range
For Each cel In rng.Cells
 
Dim Ma_variable
Ma_variable = InStr(Sheets("feuil1").Range("A" & cel.Row), "+")
    If Ma_variable > 0 Then
        Dim Ma_ligne
        Ma_ligne = cel.Row
        Range("B" & Ma_ligne).Value = Right(Sheets("feuil1").Range("A" & Ma_ligne).Value, Len(Sheets("feuil1").Range("A" & Ma_ligne).Value) - Ma_variable - 1) '-1 final pour virer espace du départ
        Range("A" & Ma_ligne).Value = Left(Sheets("feuil1").Range("A" & Ma_ligne).Value, Ma_variable - 2) '-2 pour virer l'espace et le +
    End If
Next cel
 
End Sub
 
Sub test2()
 
Dim rng As Range: Set rng = Application.Range("Feuil1!b2:b16")
Dim cel As Range
For Each cel In rng.Cells
 
Dim Ma_variable
Ma_variable = InStr(Sheets("feuil1").Range("b" & cel.Row), "+")
    If Ma_variable > 0 Then
        Dim Ma_ligne
        Ma_ligne = cel.Row
        Range("c" & Ma_ligne).Value = Right(Sheets("feuil1").Range("b" & Ma_ligne).Value, Len(Sheets("feuil1").Range("b" & Ma_ligne).Value) - Ma_variable - 1) '-1 final pour virer espace du départ
        Range("b" & Ma_ligne).Value = Left(Sheets("feuil1").Range("b" & Ma_ligne).Value, Ma_variable - 2) '-2 pour virer l'espace et le +
    End If
Next cel
 
End Sub

En gros je lui fais copier les données s'il y a un + dans le texte dans la colonne de Droite puis j'enlève à la source le résiduel

Reste à copier les données en B et C et les mettre sous A puis trier et virer les doublons mais ca tu dois l'avoir

[Franc]

Salut, voici mon approche, testée et fonctionne:

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
Sub CopyData()
    ' Déclaration des variables
    Dim wsTableau As Worksheet
    Dim wsTemp As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As String
    Dim splitValues() As String
 
    ' Définition des feuilles de calcul
    Set wsTableau = ThisWorkbook.Sheets("Tableau")
    Set wsTemp = ThisWorkbook.Sheets("Temp")
 
    ' Trouver la dernière ligne de données dans la colonne C de la feuille "Tableau"
    lastRow = wsTableau.Cells(wsTableau.Rows.Count, "C").End(xlUp).Row
 
    ' Boucle à travers les cellules de la colonne C de la feuille "Tableau"
    For i = 7 To lastRow
        ' Récupérer la valeur de la cellule courante
        cellValue = wsTableau.Cells(i, "C").Value
 
        ' Vérifier si la cellule contient un signe "+"
        If InStr(cellValue, "+") > 0 Then
            ' Si oui, diviser les valeurs en utilisant le signe "+" comme séparateur
            splitValues = Split(cellValue, "+")
 
            ' Supprimer les espaces avant et après chaque valeur
            For J = LBound(splitValues) To UBound(splitValues)
                splitValues(J) = Trim(splitValues(J))
            Next J
 
            ' Copier les valeurs divisées dans la feuille "Temp"
            wsTemp.Cells(wsTemp.Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(UBound(splitValues) + 1).Value = Application.Transpose(splitValues)
        Else
            ' Si non, copier la valeur dans la feuille "Temp" après avoir supprimé les espaces avant et après
            wsTemp.Cells(wsTemp.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = Trim(cellValue)
        End If
    Next i
 
    ' Trouver la dernière ligne de données dans la colonne C de la feuille "Temp"
    lastRow = wsTemp.Cells(wsTemp.Rows.Count, "C").End(xlUp).Row
 
    ' Supprimer les doublons et trier les données par ordre alphabétique
    With wsTemp.Range("C6:C" & lastRow)
        .RemoveDuplicates Columns:=1, Header:=xlNo
        .Sort Key1:=wsTemp.Range("C7"), Order1:=xlAscending, Header:=xlNo
    End With
End Sub

[Arnal58]

Merci beaucoup pour les solutions, ma macro est pleinement fonctionnelle avec vos ajouts.