在workbook2中查找值并将偏移值复制到workbook1
在workbook2中查找值并将偏移值复制到workbook1
提问于 2017-10-03 22:59:47
(编写脚本的新手)我正在处理BOM，以便为另一个电子表格中的零件添加成本信息，并将其添加到我的BOM电子表格中。我的代码工作正常，直到找不到零件号。然后我得到了对象变量..not集。
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我尝试将代码更改为不使用select和activate。它遍历并填充单元格，但不是返回#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回答 1
Stack Overflow用户
发布于 2017-10-14 01:49:56
我不确定为什么你的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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/46547671
复制相关文章
相似问题
腾讯云开发者
