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

也為我工作。