我正在制作多张报告。我的第一张表是客户列表（姓名，地址，路线等），没有重复。我有一个单独的属于客户的项目列表（客户1，项目1，客户1，项目2等），我在项目列表中循环并复制第2,3和4列的内容，其中当前客户名称在A列中。
一旦用尽，我想转移到客户列表中的下一个客户，然后再次选择属于该客户的项目。我的外在声明有效，但我的内心不合适。我尝试了一些没有运气的变种。这是我的潜艇......
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
答案 0 :(得分：0)
经过多次试验和错误，我已经解决了我的问题！我让它运行，花了两个多小时。不确定我是否可以优化，但我很高兴它正在工作。无论如何，这是我对任何感兴趣的人的解决方案。谢谢你的帮助。
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