用于更改列参考的VLookup宏
我想为vlookup创建宏,但在我的情况下,列引用自动从1条标准更改为下一条。问题如下:用于更改列参考的VLookup宏
在一张excel表中,我列出了所有公司的&可用产品。
http://wikisend.com/download/910578/product.jpg
现在我已经为每个公司的纸张。我想查看每个公司&将可用产品放在特定的公司表单中。新的工作表将如下所示。
http://wikisend.com/download/482612/single comp.png
我不能只是复制&插入列在每个公司列目前已经命名的产品。另外,我希望宏是为所有公司做的(每家公司都有一张单独的表格)。
谢谢你的帮助。
更新的代码:
Sub UpProd()
Dim ws As Worksheet
Dim DataRange As Range, UpdateRange As Range, aCell As Range, bCell As Range
Dim s As String
Dim z As Variant
s = "X1,X2,X3"
z = VBA.Split(s, ",")
On Error GoTo Err
For Each i In z
Set ws = Worksheets("Sheet5")
Set UpdateRange = Worksheets(i).Range("A2:A21")
Set DataRange = ws.Range("A2:A12")
For Each aCell In UpdateRange
Set bCell = DataRange.Find(What:=aCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
aCell.Offset(, 1) = bCell.Offset(, 1)
End If
Next
Next i
Exit Sub
Err:
MsgBox Err.Description
End Sub
好举措,试图解决这个问题:)。你非常接近!您必须事实上遍历所有工作表,然后使用2 .Finds
。一个用于公司名称,另一个用于产品。
看到这个代码(久经考验)
请确保您花点时间阅读,我把意见。
Option Explicit
Sub Sample()
Dim wsP As Worksheet, ws As Worksheet
Dim lRow As Long, i As Long
Dim aCell As Range, bCell As Range
'~~> Replace below with the name of the sheet which has the products
Set wsP = Sheets("Product")
'~~> Loop through every sheet
For Each ws In ThisWorkbook.Sheets
'~~> Ensure that we ignore the product sheet
If ws.Name <> wsP.Name Then
With ws
'~~> Get the last row of Col A in ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Check the rows in product sheet to find which column
'~~> has the Company name I am assuming that the company
'~~> names are in row 1 unlike row 2 in your screenshot
'~~> If it is actually 2 then change Rows(1) to Rows(2)
Set aCell = wsP.Rows(1).Find(What:=ws.Name, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'~~> Check if company name is found
If Not aCell Is Nothing Then
For i = 2 To lRow
'~~> Check Column 1 to find the product
Set bCell = wsP.Columns(1).Find(What:=ws.Range("A" & i).Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'~~> If found then pick up the value from the relevant column
If Not bCell Is Nothing Then _
ws.Range("B" & i).Value = wsP.Cells(bCell.Row, aCell.Column).Value
Next i
Else
MsgBox "Company Name not found. Moving on to the next sheet"
End If
End With
End If
Next ws
MsgBox "Done"
End Sub
它工作得很好。过去一周我一直在努力解决这个问题。谢谢你的帮助! – Beta 2012-08-10 11:12:18
我已经准备好了代码,但正在等待你展示你所做的一些努力;)所以基本上所有的感谢你:) – 2012-08-10 11:18:29
imgur此刻正在关闭。你能上传wikisend.com上的图片并在这里分享链接吗? – 2012-08-10 08:59:03
嗨Siddharth,我把wikisend放在了我的帖子里。谢谢 – Beta 2012-08-10 09:12:00
所以如果我理解正确,你有像X1,X2这样的工作表......并且你想更新产品表中的值? – 2012-08-10 10:01:58