Macro concatenation dernière colonne

Version imprimable

15/03/2012, 15h31
stevenP

Macro concatenation dernière colonne

Bonjour,

J'ai un soucis sur mon fichier Excel !

J'ai un fichier excell généré par BO XI et je dois le travailler.
Je dois créer une macro qui me concatene la dernière colonne de chaque ligne si les lignes sont identiques. Je m'explique.

J'ai par exemple ces 4 lignes :

0006GBB8 / MARZIN / DIJON / 21000 / A010
0006GBB8 / MARZIN / DIJON / 21000 / A014
0006GBB8 / MARZIN / DIJON / 21000 / A065
0001JDG7 / PAWLAK / LILLE / 59000 / A041

et j'aimerais que cela donne 2 lignes :

0006GBB8 / MARZIN / DIJON / 21000 / A010 A014 A065
0001JDG7 / PAWLAK / LILLE / 59000 / A041

J'ai réussis a le faire sans maccro mais je ne peux pas depasser 2 lignes..

Quelqu'un aurait-il la solution ?

Merci d'avance !

Bonsoir
Les lignes doublons se suivent ou pas forcément?

EDIT
Si les lignes doublons se suivent, ci-joint code utilisant les variables tableaux

Données en Feuil1 de A1:Exx (ligne 1 celle des titres)

Code:

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
Sub Compile()
Dim LastLig As Long, i As Long
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        'Adapte le nom de ta feuille
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    If LastLig > 2 Then
        Tb = .Range("A1:E" & LastLig + 1).Value
        For i = UBound(Tb, 1) To 3 Step -1
            If Not NonDoublons(Tb, i) Then
                Tb(i - 1, UBound(Tb, 2)) = Tb(i - 1, UBound(Tb, 2)) & " " & Tb(i, UBound(Tb, 2))
                Efface Tb, i
            End If
        Next i
        .Range("A1:E" & LastLig + 1).Value = Tb
    End If
End With
End Sub
 
'------------------------------------------
Private Function NonDoublons(ByVal Tb, ByVal i As Long) As Boolean
Dim k As Byte
 
For k = 1 To UBound(Tb, 2) - 1
    If Tb(i - 1, k) <> Tb(i, k) Then
        NonDoublons = True
        Exit For
    End If
Next k
End Function
 
'------------------------------------------
Private Sub Efface(ByRef Tb, ByVal i As Long)
Dim j As Long
Dim k As Byte
 
For j = i To UBound(Tb, 1) - 1
    For k = 1 To UBound(Tb, 2)
        Tb(j, k) = Tb(j + 1, k)
        Tb(j + 1, k) = Empty
    Next k
Next j
End Sub

19/03/2012, 10h40
stevenP

Merci ça marche niquel ! c'est exactement ça ! :D

Par contre, un petit detail mais qui a son importance !

Comment je peux faire pour que les lignes qu'il efface, se suppriment COMPLETEMENT ? Parce que quand j'exporte en CSV du coup il me sort plein de ligne vide :?