Слишком много циклов с vlookup

Question

Я строю отчет из нескольких листов.Мой первый лист - это список клиентов (имя, адрес, маршрут и т. Д.), Без дубликатов.У меня есть отдельный список товаров, принадлежащих клиентам (клиент 1, товар 1; клиент 1, товар 2 и т. Д.), И я перебираю список товаров и копирую содержимое столбцов 2, 3 и 4, где находится текущий клиентимя находится в столбце А.

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

Sub BuildReport()
    Dim clRng As Range
    Dim itemRng As Range
    Dim clRow As Range
    Dim itemRow As Range
    Dim currentItemRow As Range
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long

    Set clRng = wsCustomerList.Range("A1:A" & LastRow(wsCustomerList))
    Set itemRng = wsItemInfo.Range("A2:A" & LastRow(wsItemInfo))

    i = 2
    j = 1
    k = 1
    l = 2

    For Each clRow In clRng.Rows
        wsCustomerReportCard.Range("A" & i + 2).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,1,FALSE)"
        wsCustomerReportCard.Range("A" & i + 3).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,2,FALSE)"
        wsCustomerReportCard.Range("A" & i + 4).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,3,FALSE)"
        wsCustomerReportCard.Range("A" & i + 5).FormulaR1C1 = "=CONCATENATE(VLOOKUP(CustomerList!R" & j & "C1,Customers,4,FALSE)&"", ""&VLOOKUP(CustomerList!R" & j & "C1,Customers,5,FALSE)&"" ""&VLOOKUP(CustomerList!R" & j & "C1,Customers,6,FALSE))"
        wsCustomerReportCard.Range("D" & i + 2).Value = "Start Date:"
        wsCustomerReportCard.Range("E" & i + 2).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,7,FALSE)"
        wsCustomerReportCard.Range("D" & i + 3).Value = "Terms:"
        wsCustomerReportCard.Range("E" & i + 3).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,8,FALSE)"
        wsCustomerReportCard.Range("D" & i + 4).Value = "Route:"
        wsCustomerReportCard.Range("E" & i + 4).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,9,FALSE)"
        wsCustomerReportCard.Range("D" & i + 5).Value = "Delivery Days:"
        'wsCustomerReportCard.Range("E" & i + 5).FormulaR1C1 = "=IF(VLOOKUP(CustomerList!R" & j & "C1,Orders,2,FALSE)=1 then M else 0)"
        wsCustomerReportCard.Range("A" & i + 6).Value = "Item Code:"
        wsCustomerReportCard.Range("B" & i + 6).Value = "Item Desc.:"
        wsCustomerReportCard.Range("C" & i + 6).Value = "Inventory:"
        wsCustomerReportCard.Range("D" & i + 6).Value = "Minimum:"
        wsCustomerReportCard.Range("E" & i + 6).Value = "Current Price:"
        wsCustomerReportCard.Range("F" & i + 6).Value = "Last Increase:"
        wsCustomerReportCard.Range("G" & i + 6).Value = "Previous Price:"
        wsCustomerReportCard.Range("A" & i + 6 & ":G" & i + 6).Font.Bold = True

        For Each itemRow In itemRng.Rows
            l = LastRow(wsCustomerReportCard) + 1
            currentItemRow = itemRow
            wsCustomerReportCard.Range("A" & l).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & k & "C1,Items,2,FALSE)"
            wsCustomerReportCard.Range("A" & l).Font.Bold = False
            wsCustomerReportCard.Range("B" & l).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & k & "C1,Items,3,FALSE)"
            wsCustomerReportCard.Range("E" & l).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & k & "C1,Items,4,FALSE)"
            'l = LastRow(wsCustomerReportCard) + 1
            'k = k + 1
        Next itemRow
        i = LastRow(wsCustomerReportCard) + 1
        j = j + 1
    Next clRow

End Sub

Answer 1

После долгих проб и ошибок я решил свою проблему!Я позволил этому бежать, и это заняло чуть больше двух часов.Не уверен, что смогу оптимизировать, но я рад, что это работает.В любом случае, вот мое решение для тех, кто заинтересован.Спасибо за помощь.

Sub BuildReport()
    Dim customerRng As Range
    Dim customerRow As Range
    Dim itemRng As Range
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long

    Set customerRng = wsCustomerList.Range("A1:A" & LastRow(wsCustomerList))

    i = 2
    j = 1
    l = 8

    For Each customerRow In customerRng.Rows
        wsCustomerReportCard.Range("A" & i + 2).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,1,FALSE)"
        wsCustomerReportCard.Range("A" & i + 3).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,2,FALSE)"
        wsCustomerReportCard.Range("A" & i + 4).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,3,FALSE)"
        wsCustomerReportCard.Range("A" & i + 5).FormulaR1C1 = "=CONCATENATE(VLOOKUP(CustomerList!R" & j & "C1,Customers,4,FALSE)&"", ""&VLOOKUP(CustomerList!R" & j & "C1,Customers,5,FALSE)&"" ""&VLOOKUP(CustomerList!R" & j & "C1,Customers,6,FALSE))"
        wsCustomerReportCard.Range("D" & i + 2).Value = "Start Date:"
        wsCustomerReportCard.Range("E" & i + 2).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,7,FALSE)"
        wsCustomerReportCard.Range("D" & i + 3).Value = "Terms:"
        wsCustomerReportCard.Range("E" & i + 3).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,8,FALSE)"
        wsCustomerReportCard.Range("D" & i + 4).Value = "Route:"
        wsCustomerReportCard.Range("E" & i + 4).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Customers,9,FALSE)"
        wsCustomerReportCard.Range("D" & i + 5).Value = "Delivery Days:"
        wsCustomerReportCard.Range("E" & i + 5).FormulaR1C1 = "=VLOOKUP(CustomerList!R" & j & "C1,Orders,18,FALSE)"
        wsCustomerReportCard.Range("A" & i + 6).Value = "Item Code:"
        wsCustomerReportCard.Range("B" & i + 6).Value = "Item Desc.:"
        wsCustomerReportCard.Range("C" & i + 6).Value = "Inventory:"
        wsCustomerReportCard.Range("D" & i + 6).Value = "Minimum:"
        wsCustomerReportCard.Range("E" & i + 6).Value = "Current Price:"
        wsCustomerReportCard.Range("F" & i + 6).Value = "Last Increase:"
        wsCustomerReportCard.Range("G" & i + 6).Value = "Previous Price:"
        wsCustomerReportCard.Range("E" & i + 2 & ":E" & i + 5).Font.Bold = True
        wsCustomerReportCard.Range("A" & i + 6 & ":G" & i + 6).Font.Bold = True

    Set itemRng = wsItemInfo.Range("A2:A" & LastRow(wsItemInfo))

    For k = 1 To LastRow(wsItemInfo)
        'If wsItemInfo.Cells(k, 1) = customerRow Then
         Do While wsItemInfo.Cells(k, 1) = customerRow
            wsItemInfo.Cells(k, 2).Copy
            wsCustomerReportCard.Range("A" & LastRow(wsCustomerReportCard) + 1).PasteSpecial xlPasteValues
            wsItemInfo.Cells(k, 3).Copy
            wsCustomerReportCard.Range("B" & LastRow(wsCustomerReportCard, "B") + 1).PasteSpecial xlPasteValues
            wsItemInfo.Cells(k, 4).Copy
            wsCustomerReportCard.Range("E" & LastRow(wsCustomerReportCard, "E") + 1).PasteSpecial xlPasteValues
            k = k + 1
        Loop
        'End If
    Next k

    j = j + 1
    i = LastRow(wsCustomerReportCard) + 1

    Next customerRow

    MsgBox "And we're done!"

End Sub