Удаления определенного количества ячеек

[Marisabell]

Добрый день,
Уверена, что мой тяжкий труд можно оптимизировать. Прошу помощи.

Имею 2 массива данных из 3 столбцов (пример данных в приложении).
Массив данных 1:
<Уникальный код 0>.
<Уникальный код 1>.
<Уникальный код 2>. (он дублируется. Каждый код может дублироваться разное количество раз).

Массив данных 2:
<Уникальный код 2>. (он дублируется. Каждый код может дублироваться разное количество раз).
Количество записей DELETE ( эта цифра указывает количество, которые надо удалить с конца второго столбца каждого Уникального кода 2., и вывести в Новый лист удалённые записи с кодами Первого столбца).

Пожалуйста, помогите с МАКРОСОМ. Так как их около 400 000 руками это буду делать очень долго!

Не получается приложить файлы-образцы, могу выслать на мейл!!!

Спасибо!

[Казанский]

Сообщение от Marisabell

Не получается приложить файлы-образцы

Расширенный режим - "скрепка" или Управление вложениями - zip или rar.

[Marisabell]

Сообщение от Казанский

Расширенный режим - "скрепка" или Управление вложениями - zip или rar.

Именно так и делаю, но после загрузки (rar) появляется окно <Загрузка файла прошла неудачно>. Не понимаю в чем беда.

[Serge_Bliznykov]

Вы в архив файлы запаковали? Может размер получился большой?
какой размер файла, который Вы пытаетесь загрузить?


p.s. на крайний случай выложите архив на файло-хранилище (любое. хоть на http://files.mail.ru/ ) и сюда ссылку на скачивание.

[Marisabell]

Надеюсь получилось!

https://cloud.mail.ru/public/8crU/w9bxUe4VE

[Marisabell]

Сообщение от Serge_Bliznykov

Вы в архив файлы запаковали? Может размер получился большой?
какой размер файла, который Вы пытаетесь загрузить?


p.s. на крайний случай выложите архив на файло-хранилище (любое. хоть на http://files.mail.ru/ ) и сюда ссылку на скачивание.

Файл 13,5 KB

[Казанский]

Marisabell,
а если строк в массиве1 окажется меньше, чем указано в массиве2 - что делать?
Вообще какой-то отчет об операциях нужен?

[Казанский]

Пробуйте. Макрос надо запускать при активном листе Массив1. Книга с Массив2 должна быть открыта. Лучше, если будут открыты только эти две книги (увидите, почему).
Если значение из Массив2 не будет найдено или найдено в недостаточном количестве, результат будет выведен рядом с Массив2.

Sub Marisabell()
Dim c As Range, d As Range, sh As Worksheet, sh1 As Worksheet, i&, j&
Dim v(), trace$(), wb As Workbook, w As Boolean
Set sh = ActiveSheet
For Each wb In Workbooks
  If Not wb Is ThisWorkbook And wb.Windows(1).Visible Then
    wb.Activate
    j = MsgBox("Это книга со списком на удаление?", vbYesNoCancel)
    If j = vbYes Then Exit For
    If j = vbCancel Then Exit Sub
  End If
Next
If wb Is Nothing Then Exit Sub
Application.ScreenUpdating = False

v = Range("A2", Cells(Rows.Count, "B").End(xlUp)).Value
ReDim trace(1 To UBound(v), 1 To 1)
sh.Activate
Set sh1 = Worksheets.Add(after:=sh)
sh.Range("A1:C1").Copy sh1.Range("A1")

On Error Resume Next
For i = 1 To UBound(v)
  Set c = sh.Columns("C").Find(v(i, 1), , xlValues, xlWhole, , xlPrevious)
  If Not c Is Nothing Then
    Set d = c.Offset(1 - WorksheetFunction.Round(v(i, 2), 0))
    If Err Then Err.Clear: GoTo 1
    If d.Value <> c.Value Then
1     Set d = sh.Columns("C").Find(v(i, 1), , xlValues, xlWhole, , xlNext)
      trace(i, 1) = "перенесено " & c.Row - d.Row + 1
      w = True
    End If
    Range(d, c).EntireRow.Copy sh1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Range(d, c).EntireRow.Delete
  Else
    trace(i, 1) = "не найдено"
    w = True
  End If
Next
If w Then
  wb.Activate
  Range("C2").Resize(UBound(v)).Value = trace
  MsgBox "Не все прошло идеально, смотрите 3-й столбец", vbExclamation
Else
  MsgBox "Успешно", vbInformation
End If
Application.ScreenUpdating = True
End Sub

[Marisabell]

Огромное спасибо! Всё получилось! Вы просто волшебник!
Делилось всё примерно 1:20, и это просто молниеносно, по сравнению с временем, которое бы потратила на мануальную обработку!
Благодарю!