На ЛИСТ0 удалить строки со значением ЛИСТ1-СтолбецB в кол-ве ЛИСТ1-(5-СтолбецC) пример на скриншоте, так же в Лист1-СтолбецВ могут не быть числа которые есть в Лист0-СтолбецА, в этом случае оставлять 5 чисел
На ЛИСТ0 удалить строки со значением ЛИСТ1-СтолбецB в кол-ве ЛИСТ1-(5-СтолбецC) пример на скриншоте, так же в Лист1-СтолбецВ могут не быть числа которые есть в Лист0-СтолбецА, в этом случае оставлять 5 чисел iliyhabrest
Sub qq() Dim tmp(), ar, i&, x&, k&, j&, oDic AsObject, ark
ar = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value Set oDic = CreateObject("Scripting.Dictionary") For i = 1ToUBound(ar) IfNot oDic.exists(ar(i, 1)) Then
oDic.Item(ar(i, 1)) = 5
x = x + 5 EndIf Next
ar = Range(Cells(2, 2), Cells(Rows.Count, 3).End(xlUp)).Value For i = 1ToUBound(ar) If oDic.exists(ar(i, 1)) Then
oDic.Item(ar(i, 1)) = 5 - ar(i, 2) If oDic.Item(ar(i, 1)) = 0Then oDic.Remove (ar(i, 1))
x = x - ar(i, 2) EndIf Next ReDim tmp(1To x, 1To1)
ark = oDic.keys For i = 1ToUBound(tmp) If j = 0Then
j = oDic.Item(ark(k)) EndIf If j > 0Then
tmp(i, 1) = ark(k)
j = j - 1 EndIf If j = 0Then k = k + 1 Next [f2].Resize(UBound(tmp)).Value = tmp EndSub
Sub qq() Dim tmp(), ar, i&, x&, k&, j&, oDic AsObject, ark
ar = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value Set oDic = CreateObject("Scripting.Dictionary") For i = 1ToUBound(ar) IfNot oDic.exists(ar(i, 1)) Then
oDic.Item(ar(i, 1)) = 5
x = x + 5 EndIf Next
ar = Range(Cells(2, 2), Cells(Rows.Count, 3).End(xlUp)).Value For i = 1ToUBound(ar) If oDic.exists(ar(i, 1)) Then
oDic.Item(ar(i, 1)) = 5 - ar(i, 2) If oDic.Item(ar(i, 1)) = 0Then oDic.Remove (ar(i, 1))
x = x - ar(i, 2) EndIf Next ReDim tmp(1To x, 1To1)
ark = oDic.keys For i = 1ToUBound(tmp) If j = 0Then
j = oDic.Item(ark(k)) EndIf If j > 0Then
tmp(i, 1) = ark(k)
j = j - 1 EndIf If j = 0Then k = k + 1 Next [f2].Resize(UBound(tmp)).Value = tmp EndSub