Excel代码或VBA实现跨行和跨列的查找-解网

问：

上面是我要填充的表格，A 列包含一些缩写，B 列是返回结果的地方，这在工作表中可用Tool

在工作表中可用上表是要返回的信息，因此对于“工具”工作表 A 列中的每个项目，请在工作表的 B：F 列中搜索它，如果找到匹配项，则将 A 列中的值返回到工作表的 B 列。Tool BacksheetTool BacksheetTool

我不确定 VBA 是否看起来像一种复杂的方法，或者只是公式就足够了

以上是我所期望的，在多行中存在多个缩写的情况下，返回它们全部以逗号分隔。Tool Backsheet

我写了一些VBA，但似乎不起作用

Sub LookupAndIndexMatch()
    Dim wsTool As Worksheet
    Dim wsToolBacksheet As Worksheet
    Dim lastRowTool As Long
    Dim lastRowToolBacksheet As Long
    Dim i As Long
    Dim j As Long
    Dim lookupValue As String
    
    Set wsTool = ThisWorkbook.Sheets("Tool")
    Set wsToolBacksheet = ThisWorkbook.Sheets("Tool Backsheet")
    
    lastRowTool = wsTool.Cells(wsTool.Rows.Count, "A").End(xlUp).Row
    lastRowToolBacksheet = wsToolBacksheet.Cells(wsToolBacksheet.Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To lastRowTool
        lookupValue = wsTool.Cells(i, "A").Value
        For j = 1 To 5
            If wsToolBacksheet.Cells(1, j + 1).Value = lookupValue Then
                wsTool.Cells(i, "B").Value = wsToolBacksheet.Cells(j + 1, 1).Value
                Exit For
            End If
        Next j
    Next i
End Sub

如果公式可以工作，我也愿意接受。谢谢

VBA Excel-公式

Sub LookupAndIndexMatch()
    
    Dim wsTool As Worksheet, wsToolBacksheet As Worksheet, c As Range
    Dim lastRowTB As Long, rngMatch As Range, v, m
    
    Set wsTool = ThisWorkbook.Sheets("Tool")
    Set rngMatch = wsTool.Range("A2:A" & wsTool.Cells(Rows.Count, "A").End(xlUp).Row)
   
    Set wsToolBacksheet = ThisWorkbook.Sheets("Tool Backsheet")
    lastRowTB = wsToolBacksheet.Cells(wsToolBacksheet.Rows.Count, "B").End(xlUp).Row
    
    'Loop any cells with values
    For Each c In wsToolBacksheet.Range("B2:F" & lastRowTB). _
                                  SpecialCells(xlCellTypeConstants).Cells
         
         m = Application.Match(c.Value, rngMatch, 0)
         If Not IsError(m) Then 'got a match in Col A on Tool?
            With rngMatch.Cells(m).Offset(0, 1) 'Col B
                v = .Value
                'add/append value to any existing value
                v = v & IIf(Len(v) > 0, ",", "") & c.EntireRow.Columns("A").Value
                .Value = v
            End With
         End If
    Next c
  
End Sub

0赞 taller 10/28/2023 #2

Dictionary 对象用于获取唯一列表和Objectives
将数据加载到阵列中以提高效率

Option Explicit

Sub LookupAndIndexMatch()
    Dim wsTool As Worksheet
    Dim wsToolBacksheet As Worksheet
    Dim lastRowTool As Long
    Dim lastRowToolBacksheet As Long, lastCol As Long
    Dim i As Long
    Dim j As Long
    Dim lookupValue As String
    Dim objDic As Object
    Set objDic = CreateObject("scripting.dictionary")
    Set wsTool = ThisWorkbook.Sheets("Tool")
    ' Get sheet object
    Set wsToolBacksheet = ThisWorkbook.Sheets("Tool Backsheet")
    ' Get table size
    lastRowTool = wsTool.Cells(wsTool.Rows.Count, "A").End(xlUp).Row
    lastRowToolBacksheet = wsToolBacksheet.Cells(wsToolBacksheet.Rows.Count, "A").End(xlUp).Row
    lastCol = wsToolBacksheet.Cells(1, wsToolBacksheet.Columns.Count).End(xlToLeft).Column
    Dim arrData, rngData As Range, sKey
    ' Load data from wsToolBacksheet
    Set rngData = wsToolBacksheet.Range("A2", wsToolBacksheet.Cells(lastRowToolBacksheet, lastCol))
    arrData = rngData.Value
    ' Get unique list w/ Dict object
    For i = LBound(arrData) To UBound(arrData)
        For j = LBound(arrData, 2) + 1 To UBound(arrData, 2)
            sKey = Trim(arrData(i, j))
            If Len(sKey) > 0 Then
                If objDic.exists(sKey) Then
                    objDic(sKey) = objDic(sKey) & "," & arrData(i, 1)
                Else
                    objDic(sKey) = arrData(i, 1)
                End If
            End If
        Next j
    Next i
    ' Populate wsTool
    Set rngData = wsTool.Range("A2:B" & lastRowTool)
    arrData = rngData.Value
    For i = LBound(arrData) To UBound(arrData)
        sKey = Trim(arrData(i, 1))
        If objDic.exists(sKey) Then arrData(i, 2) = objDic(sKey)
    Next i
    rngData.Value = arrData
End Sub

Microsoft 文档：

Dictionary 对象

上一个：VBA 宏，用于更新包含引用外部工作表的 INDEX 函数的单元格

下一个：使用具有（重复）主键的行从列中返回值到不同的行

Excel代码或VBA实现跨行和跨列的查找

Excel code or VBA to Achieve Lookup across rows and columns

评论