Копирование диапазонов и умножение в цикле

Question

Я искал влево и вправо, но, похоже, нашел только кусочки. Я не могу объединить их в нужное мне решение. В моей книге есть список элементов на первом листе, номера деталей в столбце A нужно искать в столбце A второго листа, и, если они там существуют, эти строки необходимо скопировать на третий лист. На шагах i ' Я хочу сделать следующее:

• Столбец А листа 1 (называемый «вход») имеет несколько номеров.
• После нажатия CommandButton2 на листе 1 все номера в столбце А (начиная с ячейка A5) должна быть найдена в столбце A листа 3 (называемого "partlists", начиная с A2).
• Если найдено здесь, для всех соответствующих строк, в которых совпадают номера деталей: столбцы с 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

Работает нормально, вплоть до того, где я пытаюсь умножить и скопировать из списка поиска.

Надеюсь, кто-то может помочь

Answer 1

Я понял, ребята

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)

Делает трюк