老师可以帮忙解答吗 筛选共同有的 列出资讯

Taeng9C

此图为TR排产出对应到工作表2，左为TR排产出右为工作表2，中间红线框起的讯息，4栏对应到工作表2的ABCD4栏，I栏是呈现的结果例如右图，为手动筛选的结果， 询问: 若以"TR排机&产出" 对应至"工作表2"的ABCD栏，中间框起部分("TR排机&产出")为要找的资讯，判断若工作表2内有这些资料，秀出最左边框起的机台编号，若重复出现两次秀出是哪两台机台编号



TEST0000000.rar (595.72 KB, 下载次数: 6)

2016-12-9 12:18 上传

点击文件名下载附件

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, Brr, aa, j&, x$, Myr&
   
3. Dim d, k, t
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Sheets("工作表2").Activate
   
6. With Sheets(6)
   
7.     Myr = .Cells(.Rows.Count, 12).End(xlUp).Row
   
8.     Arr = .Range("a1:p" & Myr)
   
9. End With
   
10. For i = 4 To UBound(Arr) Step 5
    
11.     If Not IsError(Arr(i, 5)) Then   '& "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)
    
12.     x = Arr(i, 5) & "|" & Arr(i, 6) & "|" & Arr(i, 7) & "|" & Arr(i, 8)
    
13.     d(x) = d(x) & i & ","
    
14.     End If
    
15. Next
    
16. Brr = [a1].CurrentRegion
    
17. For i = 2 To UBound(Brr) Step 5
    
18.     x = Brr(i, 1) & "|" & Brr(i, 2) & "|" & Brr(i, 3) & "|" & Brr(i, 4)
    
19.     If d.exists(x) Then
    
20.         t = d(x)
    
21.         t = Left(t, Len(t) - 1)
    
22.         If InStr(t, ",") Then
    
23.             aa = Split(t, ",")
    
24.             For j = 0 To UBound(aa)
    
25.                 Cells(i, 9 + j) = Arr(aa(j), 2)
    
26.             Next
    
27.         Else
    
28.             Cells(i, 9) = Arr(t, 2)
    
29.         End If
    
30.     End If
    
31. Next
    
32. End Sub
    

复制代码

Taeng9C

蓝桥玄霜 发表于 2016-12-9 15:29

老師您好，
有些答案Lose掉了為什麼會這樣
EX下圖

蓝桥玄霜

我的附件中没有“ASMEDIA TECH.“这个数据。

Taeng9C

回老师，我本是实验看看用到新的数据上测试

以附档我检查的，下列这笔Lose掉了，为什么会这样??

LMY123

d(x) = d(x) & i & ","