Перенести по условию - VBA (48687)

Узнай цену своей работы

Формулировка задачи:

Добрый день! Имеется excel файл, напечатанного ниже формата:Лист "Исходник": Столбец "А" - код товара;Лист "Товар": Столбец "K" - код товара; Все остальные столбцы, помимо столбца K - информация о товаре; Напишите пожалуйста макрос, который перенесёт строки с листа "Товар", - код товара которых совпадает с данными в ячейках: Лист "Исходник", Столбец "А" = Лист "Товар", Столбец "K" Пример содержания ячеек с кодом товара: 12414 12 18924 1441 На листе "Товар" заполнено около 50 тыс. строк; Могут быть пустые ячейки на листе "Товар", столбец "K" - их пропускать; Прикрепляю пример файла во вложении.

Решение задачи: «Перенести по условию»

textual
Листинг программы
Option Explicit
 
Sub tt()
    Dim a, i&, t$
 
    With CreateObject("scripting.dictionary"): .comparemode = 1
        a = Sheets(1).UsedRange.Columns(1).Value
        For i = 1 To UBound(a)
            .Item(Trim(a(i, 1))) = i
        Next
        
        a = Sheets(2).UsedRange.Columns(11).Value
        For i = UBound(a) To 1 Step -1
            t = Trim(a(i, 1))
            If .exists(t) Then Sheets(2).Rows(i).Copy Sheets(1).Cells(.Item(t), 1): Sheets(2).Rows(i).Delete
        Next
 
    End With
 
End Sub

Оцени полезность:

9   голосов , оценка 4.111 из 5
Похожие ответы