用于更改列参考的VLookup宏

Question

我想为vlookup创建宏，但在我的情况下，列引用自动从1条标准更改为下一条。问题如下：

在一张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  

Answer 1

好举措，试图解决这个问题:)。你非常接近！您必须事实上遍历所有工作表，然后使用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