컬럼 변경을위한 VLookup 매크로

Question

vlookup을위한 매크로를 만들고 싶지만, 제 경우에는 열 참조가 자동으로 1 기준에서 다음 기준으로 변경됩니다. 문제는 다음과 같습니다 :

하나의 엑셀 시트에 모든 회사의 목록이 있습니다 & 사용할 수있는 제품.

http://wikisend.com/download/910578/product.jpg

는 지금은 각 회사의 시트를했습니다. 각 회사에 대해 vlookup을 원합니다 & 특정 회사 시트에 사용 가능한 제품을 넣으십시오. 새 시트는 이렇게 보입니다.

http://wikisend.com/download/482612/single comp.png

난 그냥 이미 제품의이 이름을 각 회사의 열의로 & 삽입 열을 복사 할 수 없습니다. 또한, 모든 회사 (각 회사마다 X1이라는 별도의 시트가 있음)에서 매크로를 사용하기를 원합니다.

도움 주셔서 감사합니다.

업데이트 코드 :

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