VBA 代码查找特定范围内的项目并复制到另一张表

Question

我希望代码在 Sheet3 上的列表中找到 P/N。 一旦在该范围内找到 P/N，就必须将与 P/N 位于同一行的对应的全球 P/N、品牌、描述和标价复制并添加到表 2 的类似标题下。 P/N 已经添加到表 2 中。下面是我为此尝试过的代码。 但是，即使在代码中为所有相应的 For 添加了 Next，也会出现编译错误，显示为“Next without For”。

Sub Price()

Dim pno As Double
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Integer
Dim j As Integer

LastRowinMainSheet = Cells.Find(What:="*", _
                    After:=Range("E23"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

LastRow = Worksheets(3).UsedRange.SpecialCells(x1CellTypeLastCell).Row

For j = 24 To LastRowinMainSheet
Worksheets(2).Cells(j, 5).Value = pno

For i = 3 To LastRow
If Worksheets(3).Cells(i, 2).Value = pno Then
Worksheets(3).Cells(i, 3).Copy
Worksheets(2).Cells(j, 4).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 4).Copy
Worksheets(2).Cells(j, 6).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 5).Copy
Worksheets(2).Cells(j, 7).PasteSpecial xlPasteValues
Worksheets(3).Cells(i, 14).Copy
Worksheets(2).Cells(j, 12).PasteSpecial xlPasteValues
Next i

Next j


End Sub

Answer 1

如果你错过了结束

这将在 VBA 中具有相同的错误消息。

编辑 2021-03-25A 好的，所以在不知道数据的确切形状的情况下，我认为您看起来像这样：

Sub Price()

Dim pno As Double
Dim LastRow As Long
Dim i As Integer
Dim LastRowinMainSheet As Integer
Dim j As Integer
                
LastRowinMainSheet = Worksheets(2).Cells(Worksheets(2).Rows.Count, "E").End(xlUp).Row

LastRow = Worksheets(3).Cells(Worksheets(2).Rows.Count, "E").End(xlUp).Row

For j = 24 To LastRowinMainSheet
    pno = Worksheets(2).Cells(j, 5).Value

    For i = 3 To LastRow
        If Worksheets(3).Cells(i, 2).Value = pno Then
            Worksheets(3).Cells(i, 3).Copy
            Worksheets(2).Cells(j, 4).PasteSpecial xlPasteValues
        
            Worksheets(3).Cells(i, 4).Copy
            Worksheets(2).Cells(j, 6).PasteSpecial xlPasteValues
        
            Worksheets(3).Cells(i, 5).Copy
            Worksheets(2).Cells(j, 7).PasteSpecial xlPasteValues
        
            Worksheets(3).Cells(i, 14).Copy
            Worksheets(2).Cells(j, 12).PasteSpecial xlPasteValues
        End If
     Next i
Next j


End Sub

这在我的机器上工作。

请注意 pno [表 (2) 中的第 5 列和表 (3) 中的第 2 列] 的条目当前必须是数字。

在您的代码中，交换：

LastRowinMainSheet = Cells.Find(What:="*", _
                After:=Range("E23"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

至

LastRowinMainSheet = Worksheets(3).Cells.Find(What:="*", _
                After:=Range("E23"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

也为我工作。