VBA - 从另一个工作表中查找多行，粘贴为值答案

【问题标题】：VBA - Vlookup multiple rows from another sheet, paste as valuesVBA - 从另一个工作表中查找多行，粘贴为值
【发布时间】：2021-04-06 11:27:09
【问题描述】：

我一直在努力解决这个问题，但必须走运。

我在工作表2上有一个从 A5 开始的列表。我需要从 A5 向下查找每个项目，直到 A 列中的最后一个单元格（列表的大小永远不会相同）。数据/信息将在工作表1上。然后粘贴（作为值）从单元格 C5 开始的数据，直到 A 列中最后一个对应的单元格。

工作表1 上的数据很可能始终位于 A:L 列中，但这可能会发生变化，因此我希望使其成为动态的，代码可以知道数据在哪一列结束。数据将始终从 A1 开始。

我不确定如何循环播放。希望通过 VBA 使用启用宏的按钮来实现这一点，我开始编程。

提前致谢！

【问题讨论】：

标签： excel vba

【解决方案1】：

sub lookup
  dim x as long, lastrow as long

  lastrow = Sheet2.cells(rows.count,1).end(xlup).row

  for x = 5 to lastrow
    Sheet2.Range("C" & x) = worksheetfunction.xlookup arg1:=sheet2.range("A" & x), _
    arg2:= Sheet1.Range("A:A"), arg3:=Sheet1.range("B:B")
  next x

end sub

我认为您需要确定要返回的列，以使 VBA 变得简单。根据我认为您可以循环遍历的列，直到找到您正在寻找的标题，但如果它总是在同一个地方会更好。

此代码表示，对于 sheet2 的工作表长度，从 c5 xlookup 开始，查找您的密钥，在工作表 1 上找到它，然后返回包含您的数据的列。

【讨论】：

【解决方案2】：

您似乎正在 Worksheet1 中查找行号，然后打算从该行传输所有可用数据。这将是 MATCH 工作表函数或 VBA 中的Find 的工作。请尝试以下代码。

Sub MatchAndCopy()
    ' 213

    Dim Rng         As Range                ' source data
    Dim Arr         As Variant              ' one row of data
    Dim Crit        As Variant              ' match criterium
    Dim Fnd         As Range                ' match found
    Dim R           As Long                 ' loop counter: rows
    Dim Spike       As String               ' collecting failures
    
    Set Rng = Worksheets("Sheet1").UsedRange
    Application.ScreenUpdating = False      ' speed up execution
    
    With Worksheets("Sheet2")
        For R = 5 To .Cells(.Rows.Count, "A").End(xlUp).Row
            Crit = .Cells(R, "A").Value
            Set Fnd = Rng.Columns(1).Find(Crit, LookIn:=xlValues, LookAt:=xlWhole)
            If Fnd Is Nothing Then
                If Len(Spike) Then Spike = Spike & vbCr
                Spike = Spike & String(5, " ") & """" & Crit & """ in row " & R
            Else
                Arr = Fnd.Offset(0, 1).Resize(1, Rng.Columns.Count - 1).Value
                .Cells(R, 2).Resize(1, UBound(Arr, 2)).Value = Arr
            End If
        Next R
    End With
    
    Application.ScreenUpdating = True
    If Len(Spike) Then
        Spike = "Transfer of the following items failed." & vbCr & Spike
    Else
        Spike = "Data were transferred successfully and without errors."
    End If
    MsgBox Spike, vbInformation, "Transfer report"
End Sub

【讨论】：