Bonjour à tous,
J'ai ajouté plus de détails dans le fichier ci-joint (cf.onglet "résultat souhaité").
Merci d'avance
J'ai ajouté plus de détails dans le fichier ci-joint (cf.onglet "résultat souhaité").
Merci d'avance
Sub Résultat()
Dim t, ut&, a, ua As Byte, resu$(), n&, i&, j As Byte
With Sheets("Base") 'à adapter
.Range("A1", .Range("A" & .Rows.Count).End(xlUp)) _
.Sort .[A1], xlAscending 'tri de précaution
t = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
End With
ut = UBound(t) - 1
a = Array("ABC", "ABD", "BFG", "BFK", "FGJ", "FYJ")
ua = UBound(a)
ReDim resu(1 To Rows.Count, 1 To 1) 'dimension maximum
n = 1
For i = 1 To UBound(resu) Step ua + 2
If IsError(Application.Match(Right(t(n, 1), 3), a, 0)) Then
resu(i, 1) = t(n, 1)
n = n + 1
If n > ut Then GoTo 1
End If
For j = 0 To ua
If Right(t(n, 1), 3) = a(j) Then
resu(i + j + 1, 1) = t(n, 1)
n = n + 1
If n > ut Then GoTo 1
End If
Next
Next
1 With Sheets("Résultat") 'à adapter
.[A1].Resize(i + j + 1) = resu
.Range("A" & i + j + 2 & ":A" & .Rows.Count).ClearContents
.Activate
End With
End Sub
ThisWorkbook.Names.Add "pas", ua + 2 'nom défini pour la MFC
=GAUCHE(A1;NBCAR(A1)-3*ESTNUM(EQUIV(DROITE(A1;3);tab;0)))<>GAUCHE(A2;NBCAR(A2)-3*ESTNUM(EQUIV(DROITE(A2;3);tab;0)))