多表查询工时计算求助

yniu88

从ERP导出数据，后要根据订单号查询到对应的物料ID，然后查到对应的工艺路线，根据工艺路线ID查找到对应的标准工时。
最后得出该订单各个工序的标准工时。
觉得应该能够用VBA来实现，如果可以利用多重数据透视表实现也好。
希望得到大家的帮助和指点，谢谢！

yniu88

请指点一下，谢谢！

蓝桥玄霜

请见代码。

yniu88

蓝桥玄霜 发表于 2018-7-15 09:54
请见代码。

谢谢蓝版主指点，自己先消化一下。然后再请教

yniu88

蓝桥玄霜 发表于 2018-7-15 09:54
请见代码。

蓝版主，谢谢您的代码。
我输入以后发现有个功能还没有达到。
就是如果这个产品有若干个物料，代码始终只能找到第一个物料并进行展开。如果是多个就无法运行了，试了下FINDNEXT函数改了下不行。
麻烦蓝版主请再指点一下。
另外如果能够在插入每一行的A列填入对应的订单分序号就更好了，谢谢！

蓝桥玄霜

请见代码。

1. Dim xh$, Arr00, n&
   
2. Dim wl, sl, r1, gx, Arr02, jt, yl, d1
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4. If Target.Count > 1 Then Exit Sub
   
5. If Target = "" Then Exit Sub
   
6. If Target.Column <> 1 Or Target.Row < 2 Then Exit Sub
   
7. Dim i&, t, aa, j&
   
8. Application.EnableEvents = False
   
9. xh = Target.Value: n = Target.Row - 1
   
10. Set d = CreateObject("Scripting.Dictionary")
    
11. Set d1 = CreateObject("Scripting.Dictionary")
    
12. Arr00 = Sheet3.[a1].CurrentRegion
    
13. For i = 3 To UBound(Arr00)
    
14.     d(Arr00(i, 16)) = d(Arr00(i, 16)) & i & ","
    
15. Next
    
16. Arr02 = Sheet5.[a1].CurrentRegion
    
17. For i = 3 To UBound(Arr02)
    
18.     d1(Arr02(i, 2)) = d1(Arr02(i, 2)) & i & ","
    
19. Next
    
20. If d.exists(xh) Then
    
21.     t = d(xh)
    
22.     t = Left(t, Len(t) - 1)
    
23.     If InStr(t, ",") Then
    
24.         aa = Split(t, ",")
    
25.         For j = 0 To UBound(aa)
    
26.             Call yy(aa(j))
    
27.         Next
    
28.     Else
    
29.         Call yy(t)
    
30.     End If
    
31. End If
    
32. Application.EnableEvents = True
    
33. End Sub
    
34. Sub yy(i)
    
35. Dim tt, aa, j&, r1
    
36.     wl = Arr00(i, 27): sl = Arr00(i, 6)
    
37.     Set r1 = Sheet4.[c:c].Find(wl, , , 1)
    
38.     If Not r1 Is Nothing Then
    
39.         gx = r1.Offset(0, -1).Value
    
40.         If d1.exists(gx) Then
    
41.             tt = d1(gx)
    
42.             tt = Left(tt, Len(tt) - 1)
    
43.             If InStr(tt, ",") Then
    
44.                 aa = Split(tt, ",")
    
45.                 For j = 0 To UBound(aa)
    
46.                     jt = Arr02(aa(j), 1)
    
47.                     Call fz(jt)
    
48.                 Next
    
49.             Else
    
50.                 jt = Arr02(tt, 1)
    
51.                 Call fz(jt)
    
52.             End If
    
53.         End If
    
54.     End If
    
55. 
    
56. End Sub
    
57. Sub fz(jt)
    
58. Dim r1
    
59.             Set r1 = Sheet6.[a:a].Find(jt, , , 1)
    
60.             If Not r1 Is Nothing Then
    
61.                 yl = Sheet6.Cells(r1.Row, 7)
    
62.                 n = n + 1
    
63.                 Cells(n, 1) = xh
    
64.                 Cells(n, 2) = wl
    
65.                 Cells(n, 3) = sl
    
66.                 Cells(n, 4) = gx
    
67.                 Cells(n, 5) = jt
    
68.                 Cells(n, 6) = yl
    
69.                 Cells(n, 7) = sl / yl * 60
    
70.             End If
    
71. 
    
72. End Sub
    

复制代码

yniu88

蓝桥玄霜 发表于 2018-7-16 09:39
请见代码。

蓝版主，您好。所以对于一个产品有多个物料，每个物料有不同工艺路线的时候会出现查找错误。我看了下代码，应该是少了一个对于sheet5的对应查找没有列出，导致第二个物料的第二个工时无法查出列出。似乎应该再加一个子程序查找循环？（代码中只查了sheet3,4,6,sheet5没有出现。而这张表是有用的）请指教。
正确运行结果应该能够如图的4行数据。

yniu88

蓝桥玄霜 发表于 2018-7-16 09:39
请见代码。

查出问题了，代码正确。是我这边的源数据存在疏漏。请版主帮忙删掉错误的回复。
抱歉！