查找，复制和粘贴单元格范围的所有可能值

Question

我有一排单元格（行元素可能不同）和另一张包含多列数据的工作表。让我们在第1页上说我们有7列数据（第一列有标题），在表2中我们有一些标题在第一行转置。任务是找到工作表2中每个标题的所有可能值。让我们在第一个单元格的第2页上说我们有标题X，然后我需要在表格1中找到与标题X相对应的所有值并采取从表1的第8列中得出结果。然后对表2中的单元格2执行相同的操作，依此类推，直到行的末尾。

有人可以分享提示或任何可能对我有用的建议。

实际上我使用了以下代码：

表（＆＃34; Sheet2的＆＃34）。选择

    Dim Lcola As Long
    Dim rng As Range

    With ActiveSheet
        Lcola = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(2, 1), .Cells(2, Lcola))
            With rng
                Range("A2").Select
                ActiveCell.Formula = "=VLOOKUP(A$1,MAP!$A$1:$I$" & lRowc & _
                ",8,FALSE)"
                Selection.AutoFill Destination:=rng, Type:=xlFillDefault
            End With
    End With

问题在于，我不确定如何多次重复该功能，或者对表1中的表2中的每个变量重复多次。我面临的另一个问题是vlookup函数总是给我第一个找到的项目。

Answer 1

使用For循环，将Sheet2中的最后一列作为计数器Max。

使用iCol跟踪您正在复制和阅读的Sheet2上的哪个列 使用iRow跟踪哪个ROW在Sheet1上有你想要的数据。

因为你知道你需要Sheet 1上的第8列，所以它总是Sheets（＆＃34; Sheet1＆＃34;），Cells（iRow，8） 并且因为您知道列标题位于Sheet2，Sheets（＆＃34; Sheet2＆＃34;），单元格（1，iCol）中的行 - 如果标题行为1。

然后在相关的Sheet2列上抓取LastRow检查并一次添加一个。

Dim iCol As Integer
Dim lastCol As Integer
Dim lastRow1 As Integer
Dim lastRow2 As Integer
Dim matchRow As Integer
Dim tempVal As String
Dim iRow As Integer
Dim nRow As Integer

Private Sub IndexMatchLoop()

lastCol = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column

For iCol = 1 To lastCol

    'Assuming your row on Sheet2 is 1.
    tempVal = Sheets("Sheet2").Cells(1, iCol)
    iRow = 1

    Call GetLastRow
    nRow = lastRow2 + 1

   'Looks up the value from Sheet2 Column Header on Column1 of Sheet1 one Row at a Time
    For iRow = 1 to lastRow1
        If Sheets("Sheet1").Cells(iRow, 1) = tempVal Then
   'Copy the data from Sheet1 Column 8 in the Rows with the value to Sheet2, the nextRow of the Col
             Sheets("Sheet2").Cells(nRow, iCol) = Sheets("Sheet1").Cells(iRow, 8)
             nRow = nRow + 1
        End If
    Next iRow

Next iCol

End Sub

Private Sub GetLastRow()
    lastRow1 = Sheets("Sheet1").Cells(65532, 1).End(xlUp).Row
    lastRow2 = Sheets("Sheet2").Cells(65532, iCol).End(xlUp).Row
End Sub

编辑：公式中的拼写错误（依赖于＆＃34的自动完成; Int＆＃34;而不是＆＃34;整数＆＃34; 编辑：添加屏幕截图