复制范围并循环乘法

Posted 2023-01-06

我一直在向左和向右搜索，但似乎只能找到点点滴滴。我无法将这些组合到所需的解决方案中。我的工作簿在第一张纸上有一个项目列表，必须在第二张纸的A列中搜索A列中的零件号，如果在那里存在，则需要将这些行复制到第三张纸中。我希望执行以下操作：

• sheet1的A列（称为“输入”）具有多个部件号。
• 单击sheet1上的CommandButton2之后，应在sheet3的A列中搜索A列（从单元格A5开始）中的所有零件号（称为“ partlists”，从A2开始）。
• [如果在此处找到，对于零件编号匹配的所有相应行：C到G（“ partlists”）列应复制到最后一行下方的sheet2（“ picklist”）列A中，E（“ picklist”列中的值“）必须与E（” input“）列中的值相乘，然后将G至K（” input“）列中的值复制到相应的行G（” Picklist“）]
• 如果未在“零件清单”上找到，请将整行从“输入”复制到最后一行下方的“选择清单”。

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

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

第一

Dim Matchres As Variant

并称呼它

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

完成技巧