Страницы: 1
RSS
Удалить определенное количество строк в одной таблице исходя из данных в другой
 
На ЛИСТ0 удалить строки со значением ЛИСТ1-СтолбецB в кол-ве ЛИСТ1-(5-СтолбецC) пример на скриншоте, так же в Лист1-СтолбецВ могут не быть числа которые есть в Лист0-СтолбецА, в этом случае оставлять 5 чисел, в прикрепленном файле пример как должно получится
 
И о кроссе напомнить http://www.excelworld.ru/forum/10-48104-1
В сообщении речь идет о Лист 0 и Лист 1, а у вас в примере все на одном листе
Изменено: Kuzmich - 23.08.2021 10:35:10
 
я подписал где лист0 и где лист 1, чтобы наглядно и понятно было
 
всем кто помогал спасибо, на другом форуме ответили, вот макрос если у кого-то появится похожая проблема:
Код
Sub qq()
    Dim tmp(), ar, i&, x&, k&, j&, oDic As Object, ark
    ar = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value
    Set oDic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ar)
        If Not oDic.exists(ar(i, 1)) Then
            oDic.Item(ar(i, 1)) = 5
            x = x + 5
        End If
    Next
    ar = Range(Cells(2, 2), Cells(Rows.Count, 3).End(xlUp)).Value
    For i = 1 To UBound(ar)
        If oDic.exists(ar(i, 1)) Then
            oDic.Item(ar(i, 1)) = 5 - ar(i, 2)
            If oDic.Item(ar(i, 1)) = 0 Then oDic.Remove (ar(i, 1))
            x = x - ar(i, 2)
        End If
    Next
    ReDim tmp(1 To x, 1 To 1)
    ark = oDic.keys
    For i = 1 To UBound(tmp)
        If j = 0 Then
            j = oDic.Item(ark(k))
        End If
        If j > 0 Then
            tmp(i, 1) = ark(k)
            j = j - 1
        End If
        If j = 0 Then k = k + 1
    Next
    [f2].Resize(UBound(tmp)).Value = tmp
End Sub

Изменено: iliya - 23.08.2021 11:47:41
 
iliya,
Цитата
я подписал где лист0 и где лист 1, чтобы наглядно и понятно было
Так и сделали бы пример с двумя листами, чтобы помогающие не гадали
 
Цитата
На ЛИСТ0 удалить строки со значением ЛИСТ1-СтолбецB в кол-ве ЛИСТ1-(5-СтолбецC)
Цитата
Удалить определенное количество строк
При активном Лист0 запустить макрос, удаляет строки в столбце А
Код
Sub DelRows()
Dim i As Long
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim n As Integer
Dim Kol As Integer
Dim cell As Range
Application.ScreenUpdating = False
  With Worksheets("Лист1")
    For i = iLastRow To 2 Step -1
      Set cell = .Columns(2).Find(Cells(i, "A"), , xlValues, xlWhole)
      If Not cell Is Nothing Then      'нашли значение на лист1 в столбце А
        n = cell.Offset(, 1)           'сколько строк удалить
        Kol = WorksheetFunction.CountIf(Range("A1:A" & iLastRow), Cells(i, "A"))
        If Kol >= n Then               'Kol - количество ячеек со значением в столбце А
          If n <> 0 Then
           Do
             Cells(i, "A").Delete
              i = i - 1
           Loop While WorksheetFunction.CountIf(Range("A1:A" & iLastRow), cell) <> Kol - n
              i = i - (Kol - n) + 1
          End If
        End If
      End If
    Next
  End With
Application.ScreenUpdating = True
End Sub
Страницы: 1
Наверх