oui, qui sont les matricules qui on participer pour chaque opération
JE CROIS qu'il faut employés des formules du genre ={IFERROR(INDEX(Details!$F$3:$F$20002;SMALL(IF((Details!$B$3:$B$20002=$A7)*(COUNTIF($A7:A7;Details!$F$3:$F$20002)=0);ROW(Details!$F$3:$F$20002)-1);1));"")}
www.excel-downloads.com
=SIERREUR(PETITE.VALEUR(SI((Details!$F$3:$F$1000=$A27)*(Details!$H$3:$H$1000=$C$4)*NON(NB.SI($L27:L27;Details!$B$3:$B$1000));Details!$B$3:$B$1000);1);"")
Sub Test()
Application.ScreenUpdating = False
Dim Source_Folder 'As ADODB.Connection
Dim Source_Filtre 'As ADODB.Recordset
Sql_Driver = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & ThisWorkbook.FullName & ";READONLY=FALSE"
Worksheets("768").Activate
Set Source_Folder = CreateObject("ADODB.Connection")
Source_Folder.Open Sql_Driver
Set Source_Filtre = CreateObject("ADODB.Recordset")
Source_Filtre.ActiveConnection = Source_Folder
For R = 27 To 38
Columns("L:R").Rows(R).ClearContents
Source_Filtre.Open _
"Select distinct Matricule from [Details$B1:P390] " & _
" where Commande=" & [C4] & " and Operation = '" & Cells(R, 1) & "'"
If Err = 0 Then
If Not Source_Filtre.EOF Then
Tb = Source_Filtre.GetRows
Cells(R, "L").Resize(, UBound(Tb, 2) + 1) = Tb
End If
End If
Source_Filtre.Close
Next
Set Source_Filtre = Nothing
Source_Folder.Close
Set Source_Folder = Nothing
End SubPrivate Sub Worksheet_Activate()
Worksheet_Change ActiveCell 'lance la macro
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim commande, tablo, d As Object, i&, resu(), source, lig&, matricule, s, ub%, a(), j%
commande = [C4]
'---liste sans doublon---
tablo = [A25].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 3 To UBound(tablo) - 1
d(tablo(i, 1)) = i - 2 'mémorise la ligne
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo) - 3)
source = Sheets("Details").UsedRange.Resize(, 8) 'matrice, plus rapide
For i = 2 To UBound(source)
If d.exists(source(i, 6)) Then
If source(i, 8) = commande Then
lig = d(source(i, 6))
matricule = source(i, 2)
If InStr(resu(lig) & Chr(1), Chr(1) & matricule & Chr(1)) = 0 Then _
resu(lig) = resu(lig) & Chr(1) & matricule
End If
End If
Next i
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [L27].Resize(UBound(resu))
.Resize(, Columns.Count - .Column + 1).ClearContents 'RAZ
For i = 1 To UBound(resu)
s = Split(Mid(resu(i), 2), Chr(1))
ub = UBound(s)
If ub > -1 Then
ReDim a(ub)
For j = 0 To ub
If IsNumeric(s(j)) Then a(j) = CDbl(s(j)) Else a(j) = s(j)
Next j
tri a, 0, ub
.Cells(i).Resize(, ub + 1) = a
End If
Next i
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim commande, tablo, d As Object, i&, resu(), source, lig&, s, ub%, a(), j%
commande = [C4]
'---liste sans doublon---
tablo = [A25].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 3 To UBound(tablo) - 1
d(tablo(i, 1)) = i - 2 'mémorise la ligne
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo) - 3)
source = Sheets("Details").UsedRange.Resize(, 8) 'matrice, plus rapide
For i = 2 To UBound(source)
If d.exists(source(i, 6)) Then
If source(i, 8) = commande Then
lig = d(source(i, 6))
resu(lig) = resu(lig) & Chr(1) & source(i, 2)
End If
End If
Next i
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [L27].Resize(UBound(resu))
.Resize(, Columns.Count - .Column + 1).ClearContents 'RAZ
For i = 1 To UBound(resu)
s = Split(Mid(resu(i), 2), Chr(1))
ub = UBound(s)
If ub > -1 Then
ReDim a(ub)
d.RemoveAll 'RAZ
For j = 0 To ub
If d.exists(s(j)) Then s(j) = "" Else d(s(j)) = "" 'supprime les doublons
If IsNumeric(s(j)) Then a(j) = CDbl(s(j)) Else a(j) = s(j)
Next j
tri a, 0, ub
.Cells(i).Resize(, ub + 1) = a
End If
Next i
End With
Application.EnableEvents = True 'réactive les évènements
End SubMerci beaucoup pour ton aide, est-ce qu'on peut mettre les quantités à cotés car j'ai inséré une colonne de quantité , ça ne marche pas. je connais la formule mais ton vba ne me permet pas d'inserer une colonne "quantité".
