提取零件记录和核对

蒋正栋

请各位老师帮忙，谢谢！
call 表格数据每周都有跟新，由于数据太多，只剪切一部分数据。

蒋正栋

感谢走过路过的老师帮帮忙！谢谢。

活在理想的世界

只要按照你的要求把上面的字段凑成一张表就OK了吗？

蒋正栋

请各位老师帮忙看看，非常感谢

蒋正栋

活在理想的世界 发表于 2016-12-19 11:55
只要按照你的要求把上面的字段凑成一张表就OK了吗？

对，感谢老师帮助

鄂龙蒙

蒋正栋 发表于 2016-12-19 11:25
感谢走过路过的老师帮帮忙！谢谢。

详细要求请说明或加我QQ：
如：【1：ABCD列数据需要从“call”表格提取过来】的条件

jsgj2023

1. Sub lfy_Adele_sz()
   
2. Dim arr, brr(), x&, y&, z&, k&
   
3. Dim crr, drr, d, d1, d2
   
4. Application.ScreenUpdating = False
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Set d1 = CreateObject("Scripting.Dictionary")
   
7. Set d2 = CreateObject("Scripting.Dictionary")
   
8. With Sheets("call")
   
9.     arr = .Range("a1").CurrentRegion
   
10.     ReDim brr(1 To UBound(arr), 1 To 14)
    
11.     For x = 2 To UBound(arr)
    
12.         If arr(x, 23) <> "" Then
    
13.             k = k + 1
    
14.             brr(k, 1) = arr(x, 23): brr(k, 2) = arr(x, 19)
    
15.             brr(k, 3) = arr(x, 13): brr(k, 4) = arr(x, 11)
    
16.         End If
    
17.     Next x
    
18. End With
    
19. With Sheets("机器编号")
    
20.     crr = .Range("a1").CurrentRegion
    
21.     For y = 2 To UBound(crr)
    
22.         If Not d.exists(crr(y, 5)) Then
    
23.             d(crr(y, 5)) = crr(y, 6)
    
24.         End If
    
25.     Next y
    
26. End With
    
27. With Sheets("ASM坏件登记")
    
28. drr = .Range("a1").CurrentRegion
    
29. For i = 2 To UBound(drr)
    
30.     s = drr(i, 2) & "," & drr(i, 5)
    
31.     ys = .Cells(i, 9).Interior.ColorIndex
    
32.     If Not d1.exists(s) Then
    
33.         d1(s) = Array(drr(i, 1), drr(i, 9), ys)
    
34.     End If
    
35. Next i
    
36. End With
    
37. With Sheets("MLS坏件登记")
    
38.     frr = .Range("a1").CurrentRegion
    
39.         For a = 2 To UBound(frr)
    
40.             sf = frr(a, 4) & "," & frr(a, 2)
    
41.                If Not d2.exists(sf) Then
    
42.                     d2(sf) = ""
    
43.                End If
    
44.         Next a
    
45. End With
    
46. For z = 1 To UBound(brr)
    
47.     If d.exists(brr(z, 2)) Then
    
48.         brr(z, 5) = d(brr(z, 2))
    
49.     End If
    
50.     ss = brr(z, 1) & "," & brr(z, 2)
    
51.     If d1.exists(ss) Then
    
52.         brr(z, 7) = d1(ss)(0): brr(z, 9) = d1(ss)(1)
    
53.         clid = d1(ss)(2)
    
54.         If clid = 43 Then
    
55.             brr(z, 8) = "调仓"
    
56.         ElseIf clid = 6 Then
    
57.             brr(z, 8) = "call 料"
    
58.         ElseIf clid = -4142 Then
    
59.             brr(z, 8) = "仓库库存更换"
    
60.         End If
    
61.     Else
    
62.         brr(z, 8) = ""
    
63.     End If
    
64.     For j = 2 To UBound(drr)
    
65.         If brr(z, 1) = drr(j, 2) And brr(z, 2) = drr(j, 5) And brr(z, 3) = drr(j, 7) Then
    
66.             brr(z, 12) = "Pass"
    
67.         End If
    
68.     Next j
    
69.     If d2.exists(brr(z, 1) & "," & brr(z, 2)) Then
    
70.         brr(z, 13) = "Pass"
    
71.     Else
    
72.         brr(z, 13) = "Fail"
    
73.     End If
    
74. Next z
    
75. Sheets("坏件记录").[a2].Resize(UBound(brr), UBound(brr, 2)) = brr
    
76. Application.ScreenUpdating = True
    
77. End Sub
    

复制代码

jsgj2023

lh_sz_lfy_Adele