Excel 复制范围并在循环中进行乘法

我一直在到处寻找，但似乎只找到了一些零碎的东西。我无法将这些结合到我需要的解决方案中。 我的工作簿在第一张工作表上有一个项目列表，必须在第二张工作表的a列中搜索a列中的零件号，如果它们存在，则需要将这些行复制到第三张工作表中。在步骤中，我将执行以下操作：

• 表1的A列（称为“输入”）有多个零件号
• 单击表1上的命令按钮2后，应在表3的A列（称为“零件列表”，从A2开始）中搜索A列（从单元格A5开始）中的所有零件号
• 如果在此处找到，则对于零件号匹配的所有相应行：应将C列至G列（“零件列表”）复制到最后一行下方的sheet2（“选择列表”）列A，必须将E列（“选择列表”）中的值乘以E列（“输入”）中的值，并将G列至K列（“输入”）复制到相应行G列（“选择列表”）
• 如果在“零件列表”中未找到，则将整行从“输入”复制到最后一行下方的“选择列表”

到目前为止，我得到了以下代码：

Sub InputPickMatch()

Dim LR As Long, i As Long, lngNextRow As Long, LookUpListInput As Range, LookUpListParts As Range

Set LookUpListInput = Sheets("Input").Range("A:A") 'lookup list Input
Set LookUpListParts = Sheets("Partlists").Range("A:A")

With Sheets("Input")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row 'last row
        For i = 5 To LR
        If IsError(Application.Match(.Cells(i, "A").Value, LookUpListParts, 0)) Then
            .Range(Cells(i, "A").Address(), Cells(i, "D").Address()).Copy
            Sheets("Picklist").Select
            lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Picklist").Range("A" & lngNextRow).PasteSpecial _
            Paste:=xlPasteValues
            .Range(Cells(i, "F").Address(), Cells(i, "K").Address()).Copy
            Sheets("Picklist").Range("E" & lngNextRow).PasteSpecial _
            Paste:=xlPasteValues
            End If
    Next i
End With

With Sheets("Partlists")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row 'last row
        For i = 3 To LR
        If IsNumeric(Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)) Then
            .Range(Cells(i, "C").Address(), Cells(i, "G").Address()).Copy
            Sheets("Picklist").Select
            lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Picklist").Range("A" & lngNextRow).PasteSpecial _
            Paste:=xlPasteValues
            'Sheets("Picklist").Cells(lngNextRow, "E") = Sheets("Input").Cells(LookUpListInput, "E") * .Cells(i, "G") 'NOT WORKING: Multiply row from lookuplist column E with .Cells(i, "G")
            'Sheets("Input").Range(Cells(LookUpList, "G").Address(), Cells(LookUpListInput, "K").Address()).Copy      'NOT WORKING: Copy row from lookuplist column G:K
            'Sheets("Picklist").Range("F" & lngNextRow).PasteSpecial                                             'Paste Picklist column G
            End If
    Next i
End With

End Sub

在我尝试从查找列表中进行乘法和复制的地方，它工作正常

希望有人能帮忙，伙计们，我明白了

Sub InputToPicklist()

Dim LR As Long, i As Long, lngNextRow As Long, LookUpListInput As Range, LookUpListParts As Range
Dim Matchres As Variant

Set LookUpListInput = Sheets("Input").Range("A:A")
Set LookUpListParts = Sheets("Partlists").Range("A:A")

With Sheets("Input")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 5 To LR
        If IsError(Application.Match(.Cells(i, "A").Value, LookUpListParts, 0)) Then
             lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
             Sheets("Picklist").Range(Cells(lngNextRow, "A").Address(), Cells(lngNextRow, "D").Address()).Value = .Range(Cells(i, "A").Address(), Cells(i, "D").Address()).Value
             Sheets("Picklist").Range(Cells(lngNextRow, "E").Address(), Cells(lngNextRow, "J").Address()).Value = .Range(Cells(i, "F").Address(), Cells(i, "K").Address()).Value
             End If
    Next i
End With

With Sheets("Partlists")
    LR = .Cells(Rows.Count, "A").End(xlUp).Row 'last row
        For i = 3 To LR
        If IsNumeric(Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)) Then
            lngNextRow = Sheets("Picklist").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Picklist").Range(Cells(lngNextRow, "A").Address(), Cells(lngNextRow, "E").Address()).Value = .Range(Cells(i, "C").Address(), Cells(i, "G").Address()).Value
            Matchres = Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)
            Sheets("Picklist").Cells(lngNextRow, "E") = Sheets("Input").Cells(Matchres, "F") * .Cells(i, "G")    'Multiply row from lookuplist column E with .Cells(i, "G")
            Sheets("Picklist").Range(Cells(lngNextRow, "F").Address(), Cells(lngNextRow, "J").Address()).Value = Sheets("Input").Range(Cells(Matchres, "G").Address(), Cells(Matchres, "K").Address()).Value     'Copy row from lookuplist column G:K

            End If
    Next i
End With

Sheets("Input").Range("A5:K138").ClearContents

End Sub

首先

并称之为

Matchres = Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)

---

当你试图复制时，会发生什么？你看到错误了吗？如果是，错误是什么？提示：您不需要

Select

语句。代码将在不选择要与之交互的工作表的情况下工作。它给出错误13类型不匹配（后者从荷兰语翻译过来，希望有意义）请查看VBA中的调整大小选项。我想这应该能解决你的问题。这里有一些信息。如果您只打算复制/粘贴值，那么也可以将值从一个范围分配到另一个范围。例：

Range（“A2”）.value=Range（“A1”）.value

@controlnetic.nomad尝试了你的建议，似乎更流畅。谢谢

Matchres = Application.Match(.Cells(i, "A").Value, LookUpListInput, 0)