Discussion :

[Mytå_Qc]

Salut le forum

Je récupère dans une ListBox sur un UserForm, une liste de fichiers
ou le tri croissant à déjà été fait

AB-13691 - Rev00 - ESSAI
AB-13691 - Rev01 - ESSAI
AB-13691 - Rev02 - ESSAI
AB-13691 - Rev03 - ESSAI
AB-13695 - Rev00 - ESSAI
AB-13700 - Rev00 - STUDY
AB-13720 - Rev01 - ABCDE
AB-13720 - Rev02 - ABCDE
AB-13720 - Rev03 - ABCDE

Et je voudrais ne garder que les dernières versions dans la même ListBox soit

AB-13691 - Rev03 - ESSAI
AB-13695 - Rev00 - ESSAI
AB-13700 - Rev00 - STUDY
AB-13720 - Rev03 - ABCDE

Quelqu'un(e) aurait une idée de la macro

Merci, et au plaisir de vous relire.

Mytå_Qc

[wilfried_42]

Bonjour myta

Je ne sais pas si j'ai compris mais voici une macro

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
 
Sub traitement()
    Dim i As Long, test1 As String, j As Long, nbl As Long
    Dim a As Integer, b As Integer, c As Integer
    Dim valeur() As String, mem1 As Long, res As Long, mem2 As String
    With UserForm1.ListBox1
        nbl = .ListCount
        ReDim valeur(nbl, 2)
        For i = 1 To nbl
            valeur(i, 1) = .List(i - 1)
            valeur(i, 2) = False
        Next i
        .Clear
        For i = 1 To nbl
            If valeur(i, 2) = False Then
                a = InStr(valeur(i, 1), "-")
                b = InStr(a + 1, valeur(i, 1), "-")
                c = InStr(b + 1, valeur(i, 1), "-")
                test1 = LTrim(RTrim(Right(valeur(i, 1), Len(valeur(i, 1)) - c)))
                mem1 = 0
                For j = 1 To nbl
                    If InStr(valeur(j, 1), test1) > 0 Then
                        a = InStr(valeur(j, 1), "-")
                        b = InStr(a + 1, valeur(j, 1), "-")
                        If Val(Mid(valeur(j, 1), a + 1, b - 1)) > mem1 Then mem1 = Val(Mid(valeur(j, 1), a + 1, b - a))
                    End If
                Next j
                mem2 = "": res = 0
                For j = 1 To nbl
                    If InStr(valeur(j, 1), test1) > 0 Then
                        a = InStr(valeur(j, 1), "-")
                        b = InStr(a + 1, valeur(j, 1), "-")
                        c = InStr(b + 1, valeur(j, 1), "-")
                        If Val(Mid(valeur(j, 1), a + 1, b - 1)) = mem1 Then
                            If Mid(valeur(j, 1), b + 1, c - b) > mem2 Then
                                res = j
                                mem2 = Mid(valeur(j, 1), b + 1, c - b)
                            End If
                        End If
                    End If
                Next j
                If res > 0 Then .AddItem valeur(res, 1)
                For j = 1 To nbl
                    If InStr(valeur(j, 1), test1) > 0 Then valeur(j, 2) = True
                Next j
            End If
        Next i
    End With
End Sub

testée en fonction de ce que j'ai compris

Bonne journée

[Mytå_Qc]

Salut Wilfred

Merci pour ta réponse, mais elle compare sur les noms des fichiers
et non sur le numéro de la revision en fonction du AB-xxxxx.

Je vais étudier ta macro pour l'adapter vraiment à ma situation.

Je reviens si problème.

Mytå_Qc

P.S. J'ai éditer la première ficelle pour ajouter un ficher
AB-13695 - Rev00 - ESSAI pour les essais.

[Mytå_Qc]

Salut le forum

Problème résolu en me basant sur le code de Wifred

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
Private Sub LastRevision()
Dim Nbre As Integer, I As Integer
Dim a As Byte, b As Byte, c As Byte
Dim valeur() As String
 
With F_Transfert.Source
    Nbre = .ListCount
    ReDim valeur(Nbre, 2)
        For I = 1 To Nbre
            valeur(I, 0) = .List(I - 1)
            a = InStr(valeur(I, 0), "-")
            b = InStr(a + 1, valeur(I, 0), "-")
            c = InStr(b + 1, valeur(I, 0), "-")
            valeur(I, 1) = RTrim(Left(valeur(I, 0), b - 1))
            valeur(I, 2) = LTrim(RTrim(Mid(valeur(I, 0), b + 1, c - b - 1)))
            If valeur(I, 1) = valeur(I - 1, 1) Then valeur(I - 1, 1) = ""
         Next I
        .Clear
        For I = 1 To Nbre
            If valeur(I, 1) <> "" Then .AddItem valeur(I, 0)
        Next I
End With
End Sub

Mytå

[wilfried_42]

Bonjour mita

Oui je vois que j'ai compliqué les choses, m'enfin content que tu aies fait la correction