Excel 自动过滤可见光单元上的VLOOKUP

我正在努力寻找可见的细胞。有两张数据表（包含所需数据）和结果表（我需要所需结果）。在数据表中，我想对“sourceid”列和所有包含“xtrader”的列进行自动筛选，我想根据“实体id”进行vlookup，并在结果表中获取“源实体id”。同样，在“optex”上进行自动筛选时，我也需要实体id

数据表

实体id 源id 源实体id 1001 xtrader xt-1 1002 xtrader xt-2 1003 xtrader xt-3 1004 xtrader xt-4 1005 xtrader xt-5 1006 xtrader xt-6 1007 xtrader xt-7 1008 xtrader xt-8 1009 xtrader xt-9 1010 xtrader xt-0 1001 奥泰斯 op-1 1002 奥泰斯 op-2 1003 奥泰斯 op-3 1004 奥泰斯 op-4 1005 奥泰斯 op-5 1006 奥泰斯 op-6 1007 奥泰斯 op-7 1008 奥泰斯 op-8 1009 奥泰斯 op-9 1010 奥泰斯 op-0

---

将您的数据转换为Excel表格，您将发现您可以用数据做更多的事情。抱歉，我无法完成此宏；希望你们中的一位能够修复索引匹配函数，这应该很好

将数据和结果表转换为表

使用具有多个条件的索引匹配函数

您想使用VBA有什么原因吗？也可以使用单元格中的多条件索引匹配函数来执行此操作

Option Explicit
Sub Lookup()

Dim wbBook As Workbook
Dim wsData, wsResult, wsSheet As Worksheet
Dim Data_Table, Result_Table As ListObject
Dim source_entity_id_Range As ListObject
Dim entity_id_Index, source_id_Index, entity_id_Result_Index, entity_id_Records As Byte
Dim X As Byte
Dim entity_id_Value, source_id_Index_Value, entity_id_Result_Value As String, ResultValue As String

            Set wbBook = ActiveWorkbook
            Set wsData = wbBook.Sheets("Data")
            Set wsResult = wbBook.Sheets("Result")

    'Delete Names Ranges from Named Manager
                Dim xName As Name
                For Each xName In Application.ActiveWorkbook.Names
                    xName.Delete
                Next
                
     'Convert the ActiveSheet into an Excel Table
            For Each wsSheet In wbBook.Worksheets
                    wsSheet.Activate
                    
                        Dim Src As Range
                        Dim TableName As Variant
                        Set Src = Range("A1").CurrentRegion
                        TableName = wsSheet.Name
                        
                            On Error Resume Next
                                wsSheet.ListObjects.Add(SourceType:=xlSrcRange, Source:=Src, _
                                xlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium28").Name = TableName
                            On Error GoTo 0
            Next wsSheet
                       
        Set Data_Table = wsData.ListObjects("Data")
        Set Result_Table = wsResult.ListObjects("Result")
                    
            entity_id_Index = Data_Table.ListColumns("entity id").Index
            source_id_Index = Data_Table.ListColumns("source id").Index
            entity_id_Result_Index = Result_Table.ListColumns("entity id").Index
            
            entity_id_Records = Data_Table.ListColumns(entity_id_Index).DataBodyRange.Count
                            
            For X = 1 To entity_id_Records
                    
                    entity_id_Value = Data_Table.DataBodyRange.Cells(X, entity_id_Index).Value
                    source_id_Index_Value = Data_Table.DataBodyRange.Cells(X, source_id_Index).Value
                    
                    entity_id_Result_Value = Result_Table.DataBodyRange.Cells(X, entity_id_Index).Value
                                  
                   Set source_entity_id_Range = Data_Table.ListColumns("source entity id")
                  
                  
                   ResultValue = WorksheetFunction.Index(source_entity_id_Range _
                    , WorksheetFunction.Match(entity_id_Result_Value, _
                    Data_Table.ListColumns("entity id").Range, 0))

            'Use a Multiple Criteria Index Match Function

             
             Next

End Sub

---

应用

公式时

不需要在单元格上循环，只需构建适当的公式并将其“写入”单元格，然后用其返回值覆盖公式

此代码构建一个

公式数组

，并将其应用于结果表中的输出范围

注意：代码包含两行调试代码，用于验证

结果

工作表中的输出范围，请在过程结束后删除这些代码行

---

假设您有这样的工作表：

这是运行以下代码后得到的结果：

---

对我只粘贴了文件的一部分。这个文件的数据超过30000行，我需要每天运行这个报告。因此我更喜欢宏。结果表不能为空。我已经有了实体ID，并且仅对于那些ID，我需要源实体ID，它的值是“xtrader”。基本上，我在可见单元格上查找“实体id”并获取“源实体id”，有人能帮我在可见单元格上查看一下吗？感谢这段代码带来了或值。有没有一种方法可以让我在两个不同的列中同时获得这两个值？如果它是可见的，它会按照您的要求同时提供这两个值。您试过了吗？它能工作吗？@EEM-这不会在结果表的最后一行停止。即使对于结果表中的空白行，我也得到了“{ n/a”<代码>。在结果表过程中，最后一行被调整为利用<代码>最后一行< /C> >，根据<代码>列A < /代码>不停止。代码>结果表中的空白行，我得到“#不适用IFERROR添加到公式中。请测试调整后的程序。如前所述，公式将只查找符合标准

ID

和

源实体

的单元格，该标准与您用于

.AutoFilter

和

Vlookup

的标准相同。请解释您坚持使用

.AutoFilter

？@EEM-在处出错。选择：停止。因为我认为在自动过滤细胞上使用Vlookup会更容易，所以我坚持这样做。只要我有我想要的结果，我可以用任何逻辑。什么错误，没有这些信息很难做任何事情。

Sub Get_SourceId()
Const kFml As String = "= IFERROR( INDEX( #COL3, MATCH( #ENT & ""#WHAT"", #COL1 & #COL2, 0 ) ), TEXT(,) )"  'Formula template
Dim aWhats As Variant
aWhats = [{"xtrader","optex"}]                                                  'Source IDs
Dim WsData As Worksheet, WsResult As Worksheet
Dim sFml As String, sWhat As String
Dim lRow As Long, b As Byte
        
    Rem Set Objects
    With ThisWorkbook
        Set WsData = .Worksheets("data")
        Set WsResult = .Worksheets("result")
        lRow = WsResult.Cells(WsResult.Rows.Count, 1).End(xlUp).Row
    End With
                
    Rem Set Formula - Data Worksheet part
    sFml = kFml
    With WsData.UsedRange
        sFml = Replace(sFml, "#COL1", .Columns(1).Address(External:=True))
        sFml = Replace(sFml, "#COL2", .Columns(2).Address(External:=True))
        sFml = Replace(sFml, "#COL3", .Columns(3).Address(External:=True))
        sFml = Replace(sFml, "[" & ThisWorkbook.Name & "]", vbNullString)       'Removes Workbook name to avoid a Formula lenght > 255 characters
    End With
    
    With WsResult.Cells(2, 1).Resize(-1 + lRow, 3)

            Rem Set Formula - Results Worksheet part
            sFml = Replace(sFml, "#ENT", .Columns(1).Address(0, 0))
            For b = 1 To UBound(aWhats)
                    
                Rem Set Formula - Results Worksheet Variable part
                sWhat = Replace(sFml, "#WHAT", aWhats(b))
                
                With .Columns(1 + b)
: Application.Goto WsResult.Cells(1), 1    'Included for debugging purposes - [Remove after procedure is final]
: .Select: Stop                            'Included for debugging purposes - Validates the length of the output range [Remove after procedure is final]
                    
                    Rem Apply FormulaArray
                    .FormulaArray = sWhat
                    .Value = .Value
        
    End With: Next: End With

End Sub

Sub Test1withvisiblecells()

  Dim sht As Worksheet, sht1 As Worksheet
  Dim i As Long
  Dim Rng As Range, a As Range, c As Range
  Dim curr_row_found As Boolean
  
  Set sht = ActiveWorkbook.Worksheets("result")
  Set sht1 = ActiveWorkbook.Worksheets("data")
  
  Set Rng = Intersect(sht1.Range("A:A"), _
                      sht1.UsedRange.Offset(1).Cells.SpecialCells(xlCellTypeVisible))
  
  For i = 2 To sht.UsedRange.Rows.Count
    curr_row_found = False
    For Each a In Rng.Areas
      For Each c In a
        If sht.Range("A" & i) = c Then
          Select Case c.Offset(, 1)
          Case "xtrader": sht.Range("B" & i) = c.Offset(, 2)
          Case "optex": sht.Range("C" & i) = c.Offset(, 2)
          Case Else: 'pass
          End Select
          curr_row_found = True
          Exit For
        End If
      Next
      If curr_row_found Then Exit For
    Next
  Next
        
End Sub