VBA Добавить строки в зависимости от того, сколько раз критерий соответствует

Question

Я довольно новичок в VBA, поэтому мой вопрос может показаться глупым для некоторых из вас.

У меня проблема с моим кодом. Я пытаюсь проверить между 2 листами (1-й: тест и 2-й: тестовые данные. В коде, который я использую под кодовым названием листов), сколько раз может выполняться критерий / мой продукт и на основе этого числа добавить столько строки под SKU / продуктом.

Что я хочу сделать, если для моего первого продукта / SKU у меня есть запас в 5 разных местах, я хочу добавить 5 строк на первом листе и увидеть количество в столбце D и расположение в столбце E.

вкладка TestData

Причина, по которой мне нужно перечислить количество в разных ячейках, заключается в том, что запас находится в разных местах, поэтому я не могу просто добавить одну ячейку. Я также добавляю скриншоты того, как выглядят мои два листа. Я еще не добавил l oop, чтобы найти местоположение, но хочу понять, как сначала добавить строки.

Sub test()

Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range

lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)

For Each cell In myrange
For i = 1 To lastrow
    If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
    result.Cells(i, 1) = testrange.Cells(i, 2)
    End If
Next i
Next cell

End Sub

Answer 1

Вот необработанная структура, о которой вы просили.

Sub test()
    ' 011

    Dim Rng As Range
    Dim Tmp As Variant
    Dim Radd As Long                            ' number of rows to add
    Dim R As Long                               ' row counter

    With Tdata
        ' Range, Cells and Rows Count, all in the same sheet
        ' exclude caption row(s)
        Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With

    Application.ScreenUpdating = False          ' speed up the process
    With TestTab
        ' end the loop in row 2 because row 1 might contain captions
        ' loop bottom to top because row numbers will change
        '   below the current row as you insert rwos
        ' column 1 = "A"
        For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
            Tmp = .Cells(R, 1).Value
            Radd = Application.CountIf(Rng, Tmp)
            If Radd > 1 Then
                .Range(.Rows(R + 1), .Rows(R + Radd)).Insert
                .Cells(R + 1, 1).Value = Radd   ' for testing purposes
            End If
        Next R
    End With

    Application.ScreenUpdating = True           ' now you look
End Sub

Как предложила наша Злая Синяя Обезьяна, вставка пустых строк и последующее их заполнение могут быть не самым эффективным способом. Вы можете скопировать строку и затем нажать Insert, чтобы вставить скопированные данные в новую строку. Получить синтаксис из Macro Recorder, если это интересно. Он работает с объектом Range так же.