Discussion :

[alexisgaudet]

Bonjour à tous,

Je commencerai par vous remercier, vous, très cher inconnu, qui saura m'accompagner dans mon VBA désarroi. Merci, grandement.

Passons aux choses sérieuses, j'ai actuellement un tableau de 8 colonnes et environ 15000 lignes. Ce que je souhaite effectuer, c'est une comparaison ligne par ligne, si on retrouve la même valeur de cellule (colonne B) alors il faudrait concaténer les cellules (des colonnes E à H) si leurs contenus sont différents dont le séparateur serait un saut de ligne. Une fois que ces lignes ont été comparées et concaténées cellule par cellule, il faudrait effacer les doublons. L'idéal serait aussi de re-numéroter les lignes de 1 à n-ligne après l'exécution.

Je joins un fichier exemple, le premier onglet est ce que j'ai actuellement, le second est le résultat que je souhaite obtenir.

Exemple.xlsx

J'espère avoir été clair.

Bien à vous,

Alexis

[Daniel.C]

Bonjour,

J'espère avoir été clair.

Ce qui n'est pas clair, c'est ton niveau de connaissance VBA. Tu pourrais commencer par copier tes données sur la feuille résultat et utiliser la méthode "RemoveDuplicates" pour supprimer les doublons. Dis-moi si tu me comprends ?

[alexisgaudet]

Bonjour Daniel,

Merci pour votre attention et votre réactivité.

Mes connaissances VBA sont très limitées, je n'ai jamais fait autre chose que de simples USF. (C'est pas gagné^^)

J'ai regardé la fonction "RemoveDuplicates", elle permet de supprimer des doublons en ciblant une ou plusieurs colonnes de référence. C'est en partie ce que je souhaite réaliser, je ne souhaite pas supprimer uniquement des doublons mais aussi extraire les informations des cellules qui ont la même en-tête de ligne (colonne B) et les concaténer pour au final, n'avoir qu'une ligne avec les informations compilées (colonne E à H).

Est-ce plus limpide ?

[Daniel.C]

Mes connaissances VBA sont très limitées, je n'ai jamais fait autre chose que de simples USF. (C'est pas gagné^^)

C'est déjà pas mal. Je voulais juste m'assurer que tu n'étais pas un débutant total. Je vais poursuivre.

[Daniel.C]

Essaie :

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
Sub test()
Dim Plage As Range, C As Range, Ligne As Variant, Ctr As Integer
With Sheets("ListeBrute")
    .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 8).Copy Sheets("ListeNette").[A4]
    Set Plage = .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Sheets("ListeNette")
    .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 8).RemoveDuplicates Columns:=2
    .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 4).Resize(, 4).ClearContents
    For Each C In Plage
        Ligne = Application.Match(C, .[B:B], 0)
        If IsNumeric(Ligne) Then
            For i = 3 To 7
                .Cells(Ligne, i + 2) = .Cells(Ligne, i + 2) & Chr(10) & C.Offset(, i)
            Next i
        End If
    Next C
    For Each C In .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 4).Resize(, 4)
        C.Value = Mid(C.Value, 2, Len(C.Value) - 1)
        If C.Column = 5 Then
            Ctr = Ctr + 1
            .Cells(C.Row, 1) = Ctr
        End If
    Next C
End With
End Sub

[alexisgaudet]

On y est presque !

L'idéal serait de ne pas reporter le résultat sur une autre feuille, et lorsque les cellules à concaténer ont un contenu identique de ne pas le répéter deux fois.

Est-ce possible ?

[Daniel.C]

Je dois m'absenter. Je vois ça au retour.

[alexisgaudet]

Pas de problème Daniel.

Je vais essayer d'avancer de mon côté.

À plus tard.

[Daniel.C]

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
Sub test2()
Dim Plage As Range, C As Range, Ligne As Variant, Ctr As Integer
Sheets.Add.Name = "ListeNette"
Sheets("ListeBrute").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "ListeNette"
ActiveSheet.Cells.Clear
With Sheets("ListeBrute")
    .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 8).Copy Sheets("ListeNette").[A4]
    Set Plage = .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Sheets("ListeNette")
    .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 8).RemoveDuplicates Columns:=2
    .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 4).Resize(, 4).ClearContents
    For Each C In Plage
        Ligne = Application.Match(C, .[B:B], 0)
        If IsNumeric(Ligne) Then
            For i = 3 To 7
                If InStr(1, .Cells(Ligne, i + 2), C.Offset(, i)) = 0 Then
                    .Cells(Ligne, i + 2) = .Cells(Ligne, i + 2) & Chr(10) & C.Offset(, i)
                End If
            Next i
        End If
    Next C
    For Each C In .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 4).Resize(, 4)
        If Len(C.Value) > 0 Then C.Value = Mid(C.Value, 2, Len(C.Value) - 1)
        If C.Column = 5 Then
            Ctr = Ctr + 1
            .Cells(C.Row, 1) = Ctr
        End If
    Next C
    Application.DisplayAlerts = False
    Sheets("ListeBrute").Delete
    Sheets("ListeNette").Name = "ListeBrute"
    Application.DisplayAlerts = True
End With
End Sub

[alexisgaudet]

Bonsoir Daniel,

Merci encore une fois pour ce travail. J'ai du mal à concevoir le principe de cet échange, comment puis-je faire pour vous remercier ?

Sinon, quelques bugs dans ce dernier code :

- Création d'une feuille ListeBrute(2) identique à l'initiale
- Création d'une feuille ListeNette vide
- Message d'erreur sur la ligne : ActiveSheet.Name = "ListeNette" avec la description "Ce nom est déjà utilisé." (Bien sûr, je n'avais que la feuille "ListeBrute" dans mon classeur avant l'exécution.)

Du coup, après adaptation, il devient :

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
Sub Concatest()
 
USF1.Show 0
USF1.Repaint
 
Dim NewSheet As Worksheet
Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))
NewSheet.Name = "ListeNette"
 
Dim Plage As Range, C As Range, Ligne As Variant, Ctr As Integer
With Sheets("Liste_Alarmes")
    .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 8).Copy Sheets("ListeNette").[A4]
    Set Plage = .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
End With
With Sheets("ListeNette")
    .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 8).RemoveDuplicates Columns:=2
    .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 4).Resize(, 4).ClearContents
    For Each C In Plage
        Ligne = Application.Match(C, .[B:B], 0)
        If IsNumeric(Ligne) Then
            For I = 3 To 7
                If InStr(1, .Cells(Ligne, I + 2), C.Offset(, I)) = 0 Then
                    .Cells(Ligne, I + 2) = .Cells(Ligne, I + 2) & Chr(10) & C.Offset(, I)
                End If
            Next I
        End If
    Next C
    For Each C In .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 4).Resize(, 4)
        If Len(C.Value) > 0 Then C.Value = Mid(C.Value, 2, Len(C.Value) - 1)
        If C.Column = 5 Then
            Ctr = Ctr + 1
            .Cells(C.Row, 1) = Ctr
        End If
    Next C
End With
 
With Sheets("Liste_Alarmes")
.Range("A5:H5", .Cells(.Rows.Count, 1).End(xlUp)).Clear
End With
 
With Sheets("ListeNette")
.Range("A5:H5", .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("Liste_Alarmes").[A5]
End With
 
Application.DisplayAlerts = False
Sheets("ListeNette").Delete
Application.DisplayAlerts = True
 
Unload USF1
End Sub

(Pour ceux qui se poseraient la question, dans mon classeur final, la feuille "ListeBrute" prise en exemple est remplacée par la feuille "Liste_Alarmes".)

J'ai rajouté l'apparition d'un USF pendant l'exécution pour un petit message d'attente (10 bonnes secondes avec ma bécane de course^^).

Merci Daniel, ça a été très constructif.

Bonne soirée.

Alexis

[Daniel.C]

Bonjour,

comment puis-je faire pour vous remercier ?

Juste en le disant, comme tu viens de le faire. Bonne journée.