zebanx
XLDnaute Accro
Bonsoir à tous,
Pour poursuivre sur un fil fort intéressant traité cet apm par Robert / Pierrejean
https://www.excel-downloads.com/thr...ipement-manquant-par-nom-et-profils.20026132/
une variante proposée ci-joint pour déterminer entre une liste complète (catégorie) et une liste du disponible (listing) les éléments qui manqueraient à placer sur un tableau complémentaire.
Le code ci-dessous fonctionne (il me semble!), mais si je pars de la sheet ("manque"), il me squeeze des données : pourquoi svp ?
Et si vous avez d'autres propositions, alternatives ou de simplification de ce code, je vous en remercie par avance.
Bonne soirée à tous
zebanx
Pour poursuivre sur un fil fort intéressant traité cet apm par Robert / Pierrejean
https://www.excel-downloads.com/thr...ipement-manquant-par-nom-et-profils.20026132/
une variante proposée ci-joint pour déterminer entre une liste complète (catégorie) et une liste du disponible (listing) les éléments qui manqueraient à placer sur un tableau complémentaire.
Le code ci-dessous fonctionne (il me semble!), mais si je pars de la sheet ("manque"), il me squeeze des données : pourquoi svp ?
Et si vous avez d'autres propositions, alternatives ou de simplification de ce code, je vous en remercie par avance.
Bonne soirée à tous
zebanx
Code:
Sub difference()
Dim tr As Variant
Dim tc(), tl()
Dim shc As Worksheet, shl As Worksheet, shm As Worksheet
Dim n%, m%, q%, r%
Set shc = Sheets("categorie")
Set shl = Sheets("listing")
Set shm = Sheets("manque")
tc = shc.Range("a2:g" & Cells(Rows.Count, 1).End(3).Row).Value2
tl = shl.Range("a2:h" & Cells(Rows.Count, 1).End(3).Row).Value2
ReDim tr(1 To UBound(tl, 1), 1 To 8)
'On Error Resume Next
'--- boucle sur chaque valeur du tableau listing
For n = LBound(tl, 1) To UBound(tl, 1)
For m = LBound(tc, 1) To UBound(tc, 1)
w = 2
If tc(m, 1) = tl(n, 2) Then
b = b + 1
tr(b, 1) = tl(n, 1): tr(b, 2) = tl(n, 2)
For q = 2 To 7
For r = 3 To 8
If tc(m, q) = tl(n, r) Then GoTo suite: '---si l'article est retrouvée dans la base sur la ligne de la catégorie
Next r
w = w + 1
tr(b, w) = tc(m, q)
suite:
Next q
End If
Next m
Next n
shm.[A2].Resize(UBound(tl, 1), 8) = tr
End Sub