代码之家 › 专栏 › 技术社区 › Dennis B

复制范围并在循环中相乘

vba excel

Dennis B · 技术社区 · 4 年前

我一直在四处寻找,但似乎只找到了零碎的东西。我无法将这些组合成我需要的解决方案。我的工作簿在第一张表上有一个项目列表,必须在第二张表的a列中搜索a列中的零件号,如果它们存在,则需要将这些行复制到第三张表中。我希望逐步做到以下几点:

表1的A列(称为“输入”)有几个零件号。
单击表1上的CommandButton2后,应在表3的A列(称为“零件列表”,从A2开始)中搜索A列(从单元格A5开始)中的所有零件号。
如果在此处找到,对于零件号匹配的所有相应行:应将列C至G(“零件清单”)复制到最后一行下方的表2(“拣选清单”)列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

在我尝试从查找列表中乘法和复制的地方,它工作得很好。

希望有人能帮忙

0 回复 | 直到 4 年前

Dennis B 4 年前

我明白了,伙计们

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)

有诀窍吗