我有一个由两张表组成的Excel工作表。
一个(表1(，带有产品列表、各自的序列号和特定零件的零件号-用户输入一个或多个序列号以过滤完整的大列表，最终得到较小的项目列表
一个单独的表(表2(，只有一列，需要更换的零件号列表
现在，我想编写一个VBA脚本，在Worksheet_Calculate((上(以下未反映(将工作表1中特定列(包含零件号的列(的过滤值与工作表2中的列表/列进行比较，并为每个产品显示一个消息框，该消息框包含在工作表2 列表中找到的编号的零件
但我很难找到在第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
有人能把我推向正确的方向吗？
匹配范围内的值
- 调整工作表、表和列名
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