通过所有工作表与索引的VBA EXCEL vlookups答案

【问题标题】：VBA EXCEL vlookups through all sheets vs index通过所有工作表与索引的VBA EXCEL vlookups
【发布时间】：2021-01-13 15:49:46
【问题描述】：

我有一个包含 200 多张表 + 索引表的 excel 文件，我正在尝试浏览所有表以从索引表中复制数据。例如，我有下表：

A   test1
B   test2
C   test3
D   test4

所以我想在索引表中进行 vlookup，并将列 K 复制到右侧表中。例如，我希望将“test1”复制到工作表“A”的单元格 A3 中。要查找的表在工作表“INDEX”中，范围 J1:K4。那可能吗？我存储了一个文件here！出于保密原因，我编辑了工作表名称和内容，并放置了一个较短的文件。

提前致谢！

【问题讨论】：

“我可以附加一个文件，但我没有找到怎么做”。你谷歌了吗？你能遵循这些准则吗：stackoverflow.com/help/minimal-reproducible-example
我不确定 vlookup 是否是现实中最好的方法，当我想到如何做到这一点时，这就是我想到的。我已经编辑了一个文件的链接我已经储存了，也许会更清楚。
我想在相应工作表的单元格 A3 中包含 INDEX 表中 K 列中的值。因此，例如，在 A3 中的工作表“A”中将写入“test1”。在工作表“B”中，仍然在 A3 中，所有工作表都将写入“test2”，依此类推。

标签： excel vba

【解决方案1】：

更新工作表

Option Explicit

Sub updateWorksheets()
    
    ' Define constants.
    Const wsName As String = "INDEX"
    Const FirstCellAddress As String = "J1"
    Const dstAddress As String = "A3"
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    ' Define Data Range.
    Dim rng As Range
    With wb.Worksheets(wsName).Range(FirstCellAddress).Resize(, 2)
        Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1).Find( _
            What:="*", _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious)
        If rng Is Nothing Then
            Exit Sub
        End If
        Set rng = .Resize(rng.Row - .Row + 1)
    End With
    
    ' Write values from Data Range to Data Array.
    Dim Data As Variant: Data = rng.Value
    
    ' Declare additional variables (to be used in the 'For Next' loop).
    Dim dst As Worksheet ' Current Destination Worksheet
    Dim i As Long ' Data Array Row Counter
    
    ' Loop through rows of Data Array.
    For i = 1 To UBound(Data, 1)
        ' Use the value in the first column to try to create a reference
        ' to the worksheet i.e. check if the worksheet exists.
        Set dst = Nothing
        On Error Resume Next
        Set dst = wb.Worksheets(Data(i, 1))
        On Error GoTo 0
        ' If the worksheet exists,...
        If Not dst Is Nothing Then
            ' ...write value from second column of Data Array
            ' to Destination Cell Range in Current Destination worksheet.
            dst.Range(dstAddress).Value = Data(i, 2)
        End If
    Next i
    
End Sub

【讨论】：