选择工作表 1 的列中的每个“过滤”值，并查找它们在工作表 2 的列的所有值中出现的情况

Question

我有一个由两张表组成的 Excel 工作表。

一个（表 1）包含产品列表、各自的序列号以及特定零件的零件号 - 用户输入一个或多个序列号来过滤完整的大列表，最终得到较小的项目列表

一张单独的表（表 2）只有一栏，列出需要更换的零件号

现在我想编写一个 VBA 脚本，在 Worksheet_Calculate() （下面未反映）上将工作表 1 中特定列（包含零件编号的列）的过滤值与工作表 2 中的列表/列进行比较，并显示一条消息每个产品的盒子包含一个零件，其编号在sheet2

列表中找到

但是我无法找到收集表 1 中所有已过滤单元格的解决方案

我假设我必须以某种方式利用 ListObjects 属性来收集特定的可见/过滤单元格，并仅将它们与表 2 中的列表进行比较

但我真的不知道如何选择那些特定的、自动过滤的单元格，或者编写一个迭代，仅考虑这些单元格，但仍与表 2 的列表/列中的所有行进行比较

现在，尽管使用 col1 和 col2 作为具有“SpecialCells(xlCellTypeVisible)”属性的范围，但它始终选择 col1 的所有单元格

我很惊讶这个选择器

prod1 = Cells(r, col1.Column).Value

尽管使用 col1 （这是一个有限的范围）会迭代所有值，而不仅仅是过滤后的值

Sub CompareTwoColumns()
    Dim col1 As Range, col2 As Range, prod1 As String, lr As Long
    Dim incol1 As Variant, incol2 As Variant, r As Long
 
    Set col1 = ActiveSheet.ListObjects("Tabel1").ListColumns.DataBodyRange.SpecialCells(xlCellTypeVisible)
    Set col2 = Worksheets("Tabel2").Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    lr = Worksheets("Tabel1").UsedRange.Rows.Count
    
    Dim cell As Range
               
    For r = 2 To lr
        prod1 = Cells(r, col1.Column).Value
   
        If prod1 <> "" Then
            Set incol2 = col2.Find(prod1, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If incol2 Is Nothing Then
                MsgBox CStr(prod1) + " Not in List"
            Else
                MsgBox CStr(prod1) + " Is in List!"
            End If
        End If
   
    Next r
End Sub

有人能够将我推向正确的方向吗？

Answer 1

匹配范围内的值

• 调整工作表、表和列名称。

Option Explicit

Sub ComparePartNumbers()

    ' Often you loop through the cells of the destination worksheet
    ' and try to find a match in the source worksheet (read, copy from)
    ' and then in another column of the destination worksheet you write
    ' e.g. Yes or No (write, copy to).
    ' The analogy doesn't quite apply in this case but I used it anyway.
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source range ('srg').
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet2")
    Dim sTbl As ListObject: Set sTbl = sws.ListObjects("Table2")
    Dim sLc As ListColumn: Set sLc = sTbl.ListColumns("Part Number")
    Dim srg As Range: Set srg = sLc.DataBodyRange
    
    ' Attempt to reference the destination range ('drg').
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    Dim dTbl As ListObject: Set dTbl = dws.ListObjects("Table1")
    Dim dLc As ListColumn: Set dLc = dTbl.ListColumns("Part Number")
    Dim drg As Range
    On Error Resume Next
        Set drg = dLc.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' Validate the destination range.
    If drg Is Nothing Then ' no visible cells
        MsgBox "No filtered values.", vbCritical
        Exit Sub
    'Else ' there are visible cells; do nothing i.e. continue
    End If
    
    ' Declare additional variables.
    Dim dCell As Range ' current destination cell
    Dim dPartNumber As String ' current part number read from the cell
    Dim sIndex As Variant ' the n-th cell where the value was found or an error
    
    ' Loop.
    For Each dCell In drg.Cells
        dPartNumber = CStr(dCell.Value)
        If Len(dPartNumber) > 0 Then ' is not blank
            sIndex = Application.Match(dPartNumber, srg, 0)
            If IsNumeric(sIndex) Then ' is a match
                'MsgBox "'" & dPartNumber & "' is in list!", vbInformation
                Debug.Print "'" & dPartNumber & "' is in list!"
            Else ' is not a match (VBA: 'Error 2042' = Excel: '#N/A')
                'MsgBox "'" & dPartNumber & "' is not in list!", vbExclamation
                Debug.Print "'" & dPartNumber & "' is not in list!"
            End If
        'Else ' is blank; do nothing
        End If
    Next dCell

End Sub