[英]Find a values in workbook2 and copy offset value to workbook1
(New to scrip writing) I am working on a BOM to add cost informatioin for parts from another spreadsheet and add it to my BOM spreadsheet. (对于脚本开发来说是新的)我正在研究BOM,以添加另一个电子表格中零件的成本信息并将其添加到我的BOM电子表格中。 The code I have works fine until the part number is not found. 我的代码可以正常工作,直到找不到零件编号。 Then I get the Object variable ..not set. 然后我得到对象变量..未设置。
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
I tried to change the code to not use select and activate. 我试图更改代码以不使用选择和激活。 It runs through and fills the cells but instead of the value it returns #N/AI want it to look at all values (part Numbers) from column B4 to end in the first workbook and find the same value in another workbook and return the adjacent cell value (Cost) to the first workbook. 它遍历并填充单元格,但它返回的不是#N / AI值,而是要查看B4列中的所有值(部件号)以在第一个工作簿中结束,并在另一个工作簿中找到相同的值并返回相邻的工作簿第一个工作簿的单元格值(费用)。 This is part of a larger module which pulls the info from a CAD program and creates the BOM 这是一个更大的模块的一部分,该模块从CAD程序中提取信息并创建BOM。
I can't figure out what the search is looking at. 我不知道搜索的内容。
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
I'm not sure why your VLookup
isn't working so i tried to replicate it with .Find
. 我不确定为什么您的VLookup
无法正常工作,所以我尝试使用.Find
复制它。 Give the below code a try and let me know if it works. 请尝试以下代码,让我知道它是否有效。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.