帮忙修改一下，以图片这个格式为数据作为引用。之前是用1表，输入太复杂了

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-17 16:18
表达能力不行，求大神帮忙一下

好了，初步调试通过

你再试一下吧。

ykcbf1100

不是一般的复杂。

代码估计你也一样子看不清楚。

1. Sub ykcbf()  '//2024.7.17   https://club.excelhome.net/thread-1697422-1-1.html?_dsign=ff819a2f
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     Set d2 = CreateObject("Scripting.Dictionary")
   
6.     Set sh = ThisWorkbook.Sheets("明细表")
   
7.     arr = Sheets("区域表").UsedRange
   
8.     For i = 2 To UBound(arr)
   
9.         For j = 1 To UBound(arr, 2)
   
10.             s = arr(i, j)
    
11.             If s <> Empty Then
    
12.                 d1(s) = arr(1, j)    '//用工序去提取区块
    
13.             End If
    
14.         Next
    
15.     Next
    
16.     st = "生产一部工业园内销车间拉线排布"
    
17.     qk = [{"包装段","老化房","装配段","测试段","主板"}]    '//区块数组
    
18.     With Sheets("排班表")
    
19.         arr = .UsedRange
    
20.         For i = 1 To UBound(arr)
    
21.             If InStr(arr(i, 1), st) Then k = k + 1: d2(k) = i   '//分块处理
    
22.         Next
    
23.     End With
    
24.     For k = 1 To d2.Count
    
25.         r1 = d2(k)
    
26.         If k = d2.Count Then r2 = UBound(arr) Else r2 = d2(k + 1) - 1  '//r1:区块第一行,r2:区块最后一行
    
27.         rq = Replace(arr(r1, 1), st, "")
    
28.         rq = Mid(rq, 2, Len(rq) - 2)       '//日期提取
    
29.         zg = Split(arr(r1 + 2, 9), Chr(10))   '//区块"包装段","老化房"提取的白班、夜班主管助理
    
30.         For y = 1 To 2
    
31.             For x = 0 To UBound(zg)
    
32.                 b = Split(zg(x), "：")
    
33.                 s = rq & "|" & b(0) & "|" & qk(y)   '//用日期+白班或夜班+区块名作为字典键值,提取主管助理名单
    
34.                 d(s) = b(1)
    
35.             Next
    
36.         Next
    
37.         For j = 5 To 6
    
38.             dy = Replace(arr(r1 + 1, j), " ", "")     '//提取白班或夜班
    
39.             For i = r1 + 2 To r2
    
40.                 cx = Split(arr(i, 2), Chr(10))(0)    '//提取产线名
    
41.                 For y = 3 To 5
    
42.                     If arr(i, j) = 1 Then
    
43.                         s = rq & "|" & cx & "|" & dy & "|" & qk(y)
    
44.                         d(s) = arr(i, j + 2)    '//区块不是"包装段","老化房"的,用日期+产线+白班或夜班+区块名作为字典键值,提取主管助理名单
    
45.                     End If
    
46.                 Next
    
47.             Next
    
48.         Next
    
49.     Next
    
50.     With Sheets("明细表")
    
51.         r = .Cells(Rows.Count, 1).End(3).Row
    
52.         .[k2:l1000] = ""
    
53.         arr = .UsedRange
    
54.         For i = 2 To UBound(arr)
    
55.             s = arr(i, 5)
    
56.             If d1.exists(s) Then
    
57.                 arr(i, 11) = d1(s)     '//K列提取区块名
    
58.             End If
    
59.             区块 = d1(s)
    
60.             rq = Format(Split(arr(i, 10))(0), "m月d日")
    
61.             tim = CDate(Split(arr(i, 10))(1))
    
62.             If tim >= CDate("07:50:00") And tim <= CDate("19:49:59") Then strDay = "白班" Else strDay = "夜班"
    
63.             If 区块 = qk(1) Or 区块 = qk(2) Then
    
64.                 s = rq & "|" & strDay & "|" & 区块
    
65.                 If d.exists(s) Then
    
66.                     arr(i, 12) = d(s)    '//区块是"包装段","老化房"的,L列提取主管名单
    
67.                 End If
    
68.             Else
    
69.                 s = rq & "|" & arr(i, 7) & "|" & strDay & "|" & 区块
    
70.                 If d.exists(s) Then
    
71.                     arr(i, 12) = d(s)      '//区块不是"包装段","老化房"的,L列提取主管名单
    
72.                 End If
    
73.             End If
    
74.         Next
    
75.         .UsedRange = arr
    
76.     End With
    
77.     Set d = Nothing
    
78.     Set d1 = Nothing
    
79.     Set d2 = Nothing
    
80.     Application.ScreenUpdating = True
    
81.     MsgBox "OK！"
    
82. End Sub
    

复制代码

ykcbf1100

初步调试通过。。。

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-17 19:04
好了，初步调试通过

你再试一下吧。

报这个，已经设置启动宏了

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-17 19:04
好了，初步调试通过

你再试一下吧。

而且代码这里也不能编辑

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-17 19:21
报这个，已经设置启动宏了

刚试了，我这里正常的。
附件已更新，，，

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-17 19:23
而且代码这里也不能编辑

你用启用宏工具强制启用宏一下。

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-17 19:25
刚试了，我这里正常的。

按照数据表这个数据是可以提取出数据来的，代码还是有点不对

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-17 19:45
按照数据表这个数据是可以提取出数据来的，代码还是有点不对

刚才我调试的时候把6月11日的数据屏蔽了，现在改回去。
你再试一下。

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-17 19:47
刚才我调试的时候把6月11日的数据屏蔽了，现在改回去。
你再试一下。

可以了，谢谢大神。