在Workbook2中找到一个值，然后将偏移值复制到Workbook1

Question

（新的脚本写作），我正在研究一个BOM，为另一个电子表格中的零件添加成本信息，并将其添加到我的BOM电子表格中。我的代码工作正常，直到找不到零件号。然后我获得对象变量..而不是设置。

Sub Costin()
Dim Partno
Dim LastcRow
Dim Rowno
LastcRow = Range("B" & Rows.Count).End(xlUp).Row
LastccRow = Range("A" & Rows.Count).End(xlUp).Row
Rowno = 4
Workbooks("cost_bom.txt").Activate
Worksheets("cost_bom").Select
' GET FIRST PART NUMBER
Range("b4").Select
Partno = ActiveCell.Value
' FIND COST OF ACTIVE PART
For Rowno = 4 To LastcRow
    Windows("Comp-cost.xlsx").Activate
    Columns("A").Select
    Selection.Find(what:=Partno, After:=ActiveCell, LookIn:=xlFormulas _
      , Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate
' >> Gives Object error on start if not commented out
  '  If Partno Is Nothing Then
  '    Windows("COST_BOM.txt").Activate
  '    ActiveCell.Offset(0, 5).Select
  '    ActiveCell.Value = "$$$$"
  '    Else
  '  End If
    ActiveCell.Offset(0, 1).Select
    Cost = ActiveCell.Value
' COPY COST TO BOM
    Application.CutCopyMode = False
    Selection.Copy
    Windows("COST_BOM.txt").Activate
    ActiveCell.Offset(0, 5).Select
    Application.CutCopyMode = False
    ActiveCell.Value = Cost
    Cells(Rowno, 2).Select
    Partno = ActiveCell.Value
Next Rowno

End Sub

我试图更改代码以不使用选择和激活。它贯穿并填充单元格，但它不是返回＃n/a的值我希望它在第一个工作簿中查看从B4列到结束的所有值（零件号），并在另一个工作簿中找到相同的值，然后将相邻的单元格值（成本）返回到第一个工作簿中。这是一个较大的模块的一部分，该模块从CAD程序中提取信息并创建BOM

我无法弄清楚搜索正在查看的内容。

Dim C As Integer, n As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngLookup As Range
Dim v
Application.ScreenUpdating = True
Set wb1 = Workbooks("cost_bom.txt")
Set ws1 = wb1.Sheets("cost_bom")
ws1.Range("g4:g100000").ClearContents
Set wb2 = Workbooks("comp-price.xlsx")
With wb2.Sheets("Sheet1")
Set rngLookup = .Range(.Cells(2, 1), .Cells(2, 2).End(xlDown)).Resize(, 3)

End With
With ws1
    C = 4
    Do Until .Cells(C, 2) = ""
    v = Application.VLookup(.Cells(C, 2).Value, rngLookup, 2, False)
        ' If Not IsError(v) Then
    .Cells(C, 7).Value = v
    C = C + 1
    Loop
End With

Answer 1

我不确定为什么您的VLookup不起作用，因此我尝试使用.Find复制它。尝试以下代码，让我知道它是否有效。

Sub MoveData()
    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lRow1 As Long, lRow2 As Long
    Dim Cell As Range, Found As Range
    Set wbk1 = Workbooks("cost_bom.txt")
    Set wbk2 = Workbooks("comp-price.xlsx")
    Set ws1 = wbk1.Worksheets("cost_bom")
    Set ws2 = wbk2.Worksheets("Sheet1")
    With ws2
        'Find last row in Col B
        lRow2 = .Range("B" & .Rows.Count).End(xlUp).Row
        'Loop through col B to find values
        For Each Cell In .Range("B4:B" & lRow2)
            'Search ws1 for Value
            Set Found = ws1.Columns(2).Find(What:=Cell.Value, _
                After:=ws1.Cells(1, 2), _
                LookIn:=xlFormulas, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False)
            If Not Found Is Nothing Then
                Cell.Offset(0, 5).Value = ws1.Cells(Found.Row, Found.Column + 1).Value
            End If
        Next Cell
    End With
End Sub