XL 2016 images de début/images de fin

[ciboulette0612]

Bonjour à tous.

J'ai un fichier comme celui qui représente pour x dossiers des images de début et des images de fin
Ex: pour le dossier 02208, l'image de début est la 1179.jpg et celle de fin la 1184.jpg
Je souhaiterai avoir pour chaque dossier, sur une même ligne une colonne image début et une autre image de fin :
829W_000115\FRAD069_10_829W_000115_022208_1179.jpg / 829W_000115\FRAD069_10_829W_000115_022208_1184.jpg

J'avais commencé à le faire à la mimine, mais le fichier comporte 660 000 lignes...
Merci de votre aide

829W_000115\FRAD069_10_829W_000115_022208_1179.jpg

829W_000115\FRAD069_10_829W_000115_022208_1180.jpg

829W_000115\FRAD069_10_829W_000115_022208_1181.jpg

829W_000115\FRAD069_10_829W_000115_022208_1182.jpg

829W_000115\FRAD069_10_829W_000115_022208_1183.jpg

829W_000115\FRAD069_10_829W_000115_022208_1184.jpg

829W_000116\FRAD069_10_829W_000116_022221_0001.jpg

829W_000116\FRAD069_10_829W_000116_022221_0002.jpg

829W_000116\FRAD069_10_829W_000116_022221_0003.jpg

829W_000116\FRAD069_10_829W_000116_022221_0004.jpg

829W_000116\FRAD069_10_829W_000116_022221_0005.jpg

829W_000116\FRAD069_10_829W_000116_022241_0377.jpg

829W_000116\FRAD069_10_829W_000116_022241_0378.jpg

829W_000116\FRAD069_10_829W_000116_022241_0379.jpg

829W_000116\FRAD069_10_829W_000116_022241_0380.jpg

829W_000116\FRAD069_10_829W_000116_022241_0381.jpg

829W_000116\FRAD069_10_829W_000116_022241_0382.jpg

829W_000116\FRAD069_10_829W_000116_022242_0409.jpg

829W_000116\FRAD069_10_829W_000116_022242_0410.jpg

829W_000116\FRAD069_10_829W_000116_022242_0411.jpg

829W_000116\FRAD069_10_829W_000116_022242_0412.jpg

829W_000116\FRAD069_10_829W_000116_022242_0413.jpg

829W_000116\FRAD069_10_829W_000116_022242_0414.jpg

829W_000116\FRAD069_10_829W_000116_022242_0415.jpg

829W_000116\FRAD069_10_829W_000116_022242_0416.jpg

 

[job75]

Bonjour ciboulette0612,

Voyez le fichier joint et la macro du bouton :

Sub Resultat()
Dim d As Object, tablo, n&, i, x$, p%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, à adapter
tablo(1, 1) = "1ère image"
tablo(1, 2) = "Dernière image"
n = 1
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    p = InStrRev(x, "_")
    x = Left(x, p)
    If p Then
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n 'mémorise la ligne
            tablo(n, 1) = tablo(i, 1) '1ère image
        End If
        tablo(d(x), 2) = tablo(i, 1) 'dernière image
    End If
Next
'---restitution---
With Sheets("Résultat")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1] '1ère cellule de restitution, à adapter
        .Resize(n, 2) = tablo
        .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
    End With
    .Columns.AutoFit 'ajustement largeurs
    With .UsedRange: End With 'actualise la barre de défilement verticale
    .Activate 'facultatif
End With
End Sub

A+

 

[ciboulette0612]

Super merci beaucoup !!!

Je n'ai jamais inséré de macro, ça me fera un exercice

 

[ciboulette0612]

Oh encore plus merci.
Je viens de voir que je n'avais plus qu'à copier mes lignes et appuyer sur le bouton. !!!

 

[pierrejean]

Bonjour Ciboulette
Un essai
edit:

un peu a la bourre moi !!!
salut Gerard

 

[sylvanu]

Bonjour Ciboulette,
Un essai en PJ.
A voir sur autant de lignes si c'est intéressant.

Sub Concatène()
    Application.ScreenUpdating = False
    Range("C:E").ClearContents
    DL = Range("A1000000").End(xlUp).Row
    'En C1 : =STXT(A1;1;NBCAR(A1)-9)
    Range("C1:C" & DL).FormulaR1C1 = "=MID(RC[-2],1,LEN(RC[-2])-9)"
    Range("C1:C" & DL).Value = Range("C1:C" & DL).Value
    ' En D1 : =SI(NB.SI($C$1:C1;C1)=1;A1;"")
    Range("D1:D" & DL).FormulaR1C1 = "=IF(COUNTIF(R1C3:RC[-1],RC[-1])=1,RC[-3],"""")"
    Range("D1:D" & DL).Value = Range("D1:D" & DL).Value
    ' En E1 : =SI(D1<>"";INDEX(A:A;LIGNE()+NB.SI(C:C;C1)-1);"")
    Range("E1:E" & DL).FormulaR1C1 = "=IF(RC[-1]<>"""",INDEX(C[-4],ROW()+COUNTIF(C[-2],RC[-2])-1),"""")"
    Range("E1:E" & DL).Value = Range("E1:E" & DL).Value
    ' Tri
    Columns("D:E").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D1:D" & DL) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("D1:E"  & DL)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' Auto largeur
    Columns("C:C").Delete Shift:=xlToLeft
    Columns("C:E").EntireColumn.AutoFit
    [A1].Select
End Sub

Les datas doivent être en colonne A, j'utilise les colonnes adjacentes de C à E.