Discussion :

[bloodyldr]

Bonjour,

Je reçois un fichier xls plusieurs fois par semaines, que je dois mettre en forme manuellement pour pouvoir l'utiliser...ce qui prends un temps fou.
Je souhaiterais donc automatiser la mise en forme, grâce à votre aide


Voici à quoi ressemble le fichier original:
(une seule colonne)


GROUPE1
USER1
USER2
USER3
USER4
GROUPE2
USER3
USER4
USER1
GROUPE3
USER5
GROUPE4
USER3
USER2
USER1
USER4
USER5
GROUPE5
USER6
USER7
(et ça sur des milliers de lignes)


Et le fichier final doit ressembler à ça:
Colonne A Colonne B

USER1 GROUPE1,GROUPE2,GROUPE4
USER2 GROUPE1,GROUPE4
USER3 GROUPE1,GROUPE2,GROUPE4
USER4 GROUPE1,GROUPE2,GROUPE4
USER5 GROUPE3,GROUPE4
USER6 GROUPE5
USER7 GROUPE5
(et ainsi de suite...)

N'étant pas très doué en VBA, je bloque assez rapidement.

Pourriez-vous m'aider, svp?

Merci d'avance,
bloodyldr

[Daniel.C]

Bonjour,

Comment tu distingues les groupes des utilisateurs ?

[bloodyldr]

Bonjour,

Les groupes commencent tous (et toujours) par la même chaîne de caractères suivie d'un tiret:

aBCD-GROUPE1
aBCD-GROUPE2
ect...

Et les users sont tous ceux qui n'ont pas cette chaîne de caractères suivie du -

J'espère que cela va t'aider

[Daniel.C]

Avec les données initiales en colonne A et les résultats à partir de la colonne D :

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
Sub test()
   Dim C As Range, Res As String, Ligne As Long, Col As Integer
   Application.ScreenUpdating = False
   For Each C In Range("A1", Cells(Rows.Count, 1).End(xlUp))
      If Left(C.Value, 5) = "aBCD-" Then
         C.Offset(, 1).Value = C.Value
      Else
         C.Offset(, 1).Value = C.Offset(-1, 1).Value
      End If
   Next C
   For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
      If Left(Cells(i, 1).Value, 5) = "aBCD-" Then Cells(i, 1).EntireRow.Delete
   Next i
   Range("A1", Cells(Rows.Count, 2).End(xlUp)).Sort [A1], xlAscending, [B1], , xlAscending, Header:=xlNo
   For Each C In Range("A1", Cells(Rows.Count, 1).End(xlUp))
      If C.Value <> Res Then
         Res = C.Value
         Ligne = Ligne + 1
         Col = 4
         Cells(Ligne, Col) = C.Value
         Col = Col + 1
         Cells(Ligne, Col) = C.Offset(, 1).Value
      Else
         Col = Col + 1
         Cells(Ligne, Col) = C.Offset(, 1).Value
      End If
   Next C
   Application.ScreenUpdating = True
End Sub

[joe.levrai]

Bonjour,

une autre proposition qui ne boucle pas directement sur la feuille
si tu as vraiment des milliers de lignes, ça devrait être plus rapide

on utilise :

- un tableau pour récolter toute ta colonne A
- un dictionnaire qui reçoit en clé chaque User, et en valeur le listing des groupes auquel il appartient
- le résultat se présente en colonne A et B

la gestion de mes indices i dans la boucle For/Next est pas très jolie ... mais ça me semble ok (testé avec tes 20 exemples)

Attention, on est sur la feuille active, si tu veux travailler sur une autre feuille il faudra la référencer

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
Sub GroupesEtUsers()
    Dim Groupe As String
    Dim i As Long
    Dim UserS
    Dim GroupeS
    Dim Tablo()
    Dim Dico As Object: Set Dico = CreateObject("Scripting.Dictionary")
 
    ' les valeurs de la colonne A
    Tablo = Application.WorksheetFunction.Transpose(Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Value)
 
    ' boucle sur les valeurs
    For i = LBound(Tablo) To UBound(Tablo)
        ' si c'est un groupe
        If Tablo(i) Like "*GROUPE*" Then
            ' on stocke son nom
            Groupe = Tablo(i)
 
            ' on passe à l'élément suivant
            i = i + 1
 
            ' tant qu'on est sur des USERS
            While Tablo(i) Like "*USER*"
 
                ' si l'USER n'existe pas encore dans le dictionnaire
                If Not Dico.exists(Tablo(i)) Then
                    ' on l'ajoute (avec le Groupe)
                    Dico.Add Tablo(i), Groupe
 
                ' si l'USER existe déjà
                Else
                    ' on ajoute le groupe à la liste de ses groupes déjà trouvés
                    Dico(Tablo(i)) = Dico(Tablo(i)) & "," & Groupe
                End If
 
                ' si on arrive en fin de tableau, on s'arrête
                If i = UBound(Tablo) Then Exit For
 
                ' on passe à l'élément suivant
                i = i + 1
            Wend
 
            ' ici, on revient sur un élément en arrière
            ' sinon on va sauter un groupe sur deux
            i = i - 1
        End If
    Next i
 
    ' on crée deux tableaux : les Users et leurs Groupes d'appartenance
    UserS = Dico.keys
    GroupeS = Dico.items
 
    ' on écrit en colonne A les users
    ' et en colonne B leurs groupes
    For i = 0 To Dico.Count - 1
        Cells(i + 1, 2) = UserS(i)
        Cells(i + 1, 3) = GroupeS(i)
    Next i
 
    Columns(1).Delete
End Sub

[bloodyldr]

wouah! Merci à vous deux, déjà pour la rapidité de vos réponses, mais surtout pour le travail effectué.

J'ai ne peux pas tester les codes avec le bon fichier actuellement, mais j'ai testé avec une centaine de lignes et tout fonctionne très bien et donne le résultat escompté

Je testerai plus tard ce weekend avec un fichier original et vous tiendrai au courant du résultat.

Bonne soirée,
bloodyldr

[Klin89]

Bonjour à tous,

A tester, tes données en colonne A à partir de la ligne 1.
Utilisation d'un dictionnaire et d'une variable tableau à 2 dimensions.

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
Option Explicit
Option Compare Text
 
Sub test()
Dim a, b(), i As Long, n As Long, x As Long, Grp As String
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        a = .Range("a1", .Range("a" & Rows.Count).End(xlUp)).Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1
        For i = 1 To UBound(a, 1)
            If Left(a(i, 1), 6) = "Groupe" Then Grp = a(i, 1)
            If Left(a(i, 1), 6) <> "Groupe" Then
                If Not .exists(a(i, 1)) Then
                    n = n + 1: b(n, 1) = a(i, 1)
                    .Item(a(i, 1)) = n
                End If
                x = .Item(a(i, 1))
                b(x, 2) = b(x, 2) & IIf(b(x, 2) <> "", ", ", "") & Grp
            End If
        Next
    End With
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Resultat").Delete
    Sheets.Add().Name = "Resultat"
    On Error GoTo 0
    With Sheets("Resultat").Cells(1)
        .Resize(n, UBound(b, 2)).Value = b
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 11
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Attention à ne pas dépasser la limite du nombre de caractéres contenus dans une cellule.
Blood.xls
klin89