Question

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

在一份excel表中，我列出了所有公司和＆amp;可用的产品。

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

现在我为每家公司准备了一张纸。我想vlookup为每个公司＆amp;将可用产品放在特定的公司表中。新表将如下所示。

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

我不能只复制＆amp;在每个公司列中插入列，已经有产品名称。此外，我希望宏为所有公司做这件事（每家公司都有一张单独的表格作为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

用于更改列参考的VLookup宏

1 个答案: