请教老师:多表查找并引用
请教老师:按“查找”按钮,将此表第二行开始(范围在A:Z),每行中,有与sheet2第二行相同的数据,提取出来,放置在从AA2开始的位置(为了说明方便,相同数据单元格已经涂绿色)。AA列及其右面的区域,放置方式:
1、AA2放置sheet1中O1单元格的数据;AB2放置提取行A列的数据(红色字体);AC3及它的右面,放置与sheet2第二行相同的数据。
2、再次按“查找”按钮时,所得数据,放在前一次查找结果的下面。
具体请见例子:
![](images/attachicons/rar.gif)
Sub clk() On Error Resume Next Dim max_row As Long With Sheet3 '对表3操作 max_row = Sheet3.[aa:aa].Find("*", , xlValues, , , xlPrevious).row '获取aa列最大行数 If max_row = 0 Then 'aa列第一行无数据,简单处理 max_row = max_row + 1 End If If .Cells(max_row + 1, 1) = "" Then '如果该行没有数据,则不处理,直接退出程序 Exit Sub End If .Cells(max_row + 1, "aa") = Sheet1.Cells(1, "o") '对aa,ab两列处理 .Cells(max_row + 1, "ab") = .Cells(max_row + 1, "a") Dim d As Object Dim k As Long Set d = CreateObject("scripting.dictionary") '创建一个字典,储存sheet2的数据,用于判断 For k = 1 To 8 'sheet2数据存入字典d d(CInt(Sheet2.Cells(2, k + 1))) = Sheet2.Cells(2, k + 1) Next Dim col As Long For col = 2 To 24 '处理一行的数据,标记颜色 .Cells(max_row + 1, col + 27) = .Cells(max_row + 1, col) If d.exists(CInt(.Cells(max_row + 1, col + 27))) Then .Cells(max_row + 1, col + 27).Interior.ColorIndex = 13 End If Next End With End Sub