Discussion :

[jeanbi]

bonjour,
n’étant vraiment pas spécialiste en vba ni macro exel
j'ai un fichier exel en provenance d'un combine de pesage étiquetage
le fichier ressemble grosso modo à cela
n° intitule
150 bernard
151 leclerc
151 paris
152 leclerc
152 lyon
160 hector
161 carrefour
161 lyon

je voudrai tout simplement lorsque le n° est égal concatener intitule
par ex 151 leclerc paris
il est certain que je pourrait le faire ligne par ligne mais j'ai + de 2000 lignes
donc c'est un peu fastidieux
si vous avez juste un petit bout de code que je pourrai ensuite adapte à mes besoin se serait super
a+

[jfontaine]

Bonjour,

Essais 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
 
Dim i As Integer  'utiliser long si ligne sup a 32000
Dim str As String
Dim c As Integer 'utiliser long si ligne sup a 32000
Dim l As Integer
 
For i = 1 To Range("A:A").End(xlDown).Row
    c = 3
    If str = Range("A" & i).Value Then
        Cells(l, c).Value = Range("B" & i).Value
        c = c + 1
    Else
        str = Range("A" & i).Value
        l = i
    End If
Next i

[Qwazerty]

Salut

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
Sub test()
Dim Tab_Already() As Integer, Tab_Resultats()
Dim Tab_ColonneBD
Dim TheCell As Range
Dim IRowP As Long, IRowS As Long, IRowM As Long 'P=Primaire, S=Secondaire, M=Maxi
Dim OneInt
Dim StrConcat As String
 
'On initialise les tableaux
ReDim Tab_Already(0)
ReDim Tab_Resultats(1, 0)
Tab_ColonneBD = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
IRowM = Cells(Rows.Count, "A").End(xlUp).Row - 1
 
For IRowP = 1 To IRowM
    'On verifie que le numero n'a pas deja ete traité
    For Each OneInt In Tab_Already
        If OneInt = CInt(Tab_ColonneBD(IRowP, 1)) Then GoTo suite
    Next
 
    'On rajoute le numero dans la liste des num deja traité (la colonne A ne doit pas contenir de 0
    If Tab_Already(UBound(Tab_Already)) <> 0 Then ReDim Preserve Tab_Already(UBound(Tab_Already) + 1)
    Tab_Already(UBound(Tab_Already)) = CInt(Tab_ColonneBD(IRowP, 1))
 
    'On initialise le concatenation avec le 1er texte
    StrConcat = CStr(Tab_ColonneBD(IRowP, 2))
    'On recherche les autres cellules contenant cette valeur à partir de IRowP+1
    For IRowS = IRowP + 1 To IRowM
        If Tab_ColonneBD(IRowP, 1) = Tab_ColonneBD(IRowS, 1) Then
            StrConcat = StrConcat + " "
            StrConcat = StrConcat + CStr(Tab_ColonneBD(IRowS, 2))
        End If
    Next
 
    'On ajoute ce resultat au tableau des resultats
    If Tab_Resultats(1, UBound(Tab_Resultats, 2)) <> "" Then ReDim Preserve Tab_Resultats(1, UBound(Tab_Resultats, 2) + 1)
    Tab_Resultats(0, UBound(Tab_Resultats, 2)) = CInt(Tab_ColonneBD(IRowP, 1))
    Tab_Resultats(1, UBound(Tab_Resultats, 2)) = StrConcat
 
suite:
Next
 
'On affiche le resultat, par exemple sur une feuille 2
Feuil2.Range("A2").Resize(UBound(Tab_Resultats, 2), 2).Value = WorksheetFunction.Transpose(Tab_Resultats)
 
End Sub

++
Qwaz

[jeanbi]

bonjour,
merci à vous 2 , c'est pile poil ce dont j'avais besoin
a+