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

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-18 20:55
日期超过当前时间3天，不太明白。你举个例子帮助我理解一下。

比如区域为主板时，且日期超过3天，才显示主管助理。如果区域不是为主板时，且日期超过13天，才显示主管助理

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-18 21:05
比如区域为主板时，且日期超过3天，才显示主管助理。如果区域不是为主板时，且日期超过13天，才显示主管 ...

你等于没说，你这样回复我就不管了。让你举例说明的，你呢？我就是不明白超过3天是啥概念，让你举例。比如今天是7月18日，超过3天是哪一天？

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-18 21:08
你等于没说，你这样回复我就不管了。让你举例说明的，你呢？我就是不明白超过3天是啥概念，让你举例。比 ...

比如今天是7月18号，超过3天就是7月14号

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-18 21:15
比如今天是7月18号，超过3天就是7月14号

看吧，我还以为是7月22日呢。所以，必须举例说明，免得浪费时间。

ykcbf1100

凌云漂流瓶2014 发表于 2024-7-18 21:05
比如区域为主板时，且日期超过3天，才显示主管助理。如果区域不是为主板时，且日期超过13天，才显示主管 ...

代码更新，增加日期比较判断。

ykcbf1100

代码更新，增加日期比较判断

1. Sub ykcbf()  '//2024.7.18   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.     today = CLng(Date)                        '//当前日期
   
8.     arr = Sheets("区域表").UsedRange
   
9.     For i = 2 To UBound(arr)
   
10.         For j = 1 To UBound(arr, 2)
    
11.             s = arr(i, j)
    
12.             If s <> Empty Then
    
13.                 d1(s) = arr(1, j)    '//用工序去提取区块
    
14.             End If
    
15.         Next
    
16.     Next
    
17.     st = "生产一部工业园内销车间拉线排布"
    
18.     qk = [{"包装段","老化房","装配段","测试段","主板"}]    '//区块数组
    
19.     With Sheets("排班表")
    
20.         arr = .UsedRange
    
21.         For i = 1 To UBound(arr)
    
22.             If InStr(arr(i, 1), st) Then k = k + 1: d2(k) = i   '//分块处理
    
23.         Next
    
24.     End With
    
25.     For k = 1 To d2.Count
    
26.         r1 = d2(k)
    
27.         If k = d2.Count Then r2 = UBound(arr) Else r2 = d2(k + 1) - 1  '//r1:区块第一行,r2:区块最后一行
    
28.         rq = Replace(arr(r1, 1), st, "")
    
29.         rq = Mid(rq, 2, Len(rq) - 2)       '//日期提取
    
30.         zg = Split(arr(r1 + 2, 9), Chr(10))   '//区块"包装段","老化房"提取的白班、夜班主管助理
    
31.         For x = 0 To UBound(zg)
    
32.             b = Split(zg(x), "：")
    
33.             s = rq & "|" & b(0) & "|" & qk(1)   '//用日期+白班或夜班+区块名作为字典键值,提取包装主管助理名单
    
34.             d(s) = b(1)
    
35.         Next
    
36.         s = rq & "|" & qk(2)           '//用日期+白班或夜班+区块名作为字典键值,提取老化房主管助理名单
    
37.         d(s) = arr(r1 + 2, 10)
    
38.         For j = 5 To 6
    
39.             dy = Replace(arr(r1 + 1, j), " ", "")     '//提取白班或夜班
    
40.             For i = r1 + 2 To r2
    
41.                 cx = Split(arr(i, 2), Chr(10))(0)    '//提取产线名
    
42.                 For y = 3 To 5
    
43.                     If arr(i, j) = 1 Then
    
44.                         s = rq & "|" & cx & "|" & dy & "|" & qk(y)
    
45.                         d(s) = arr(i, j + 2)    '//区块不是"包装段","老化房"的,用日期+产线+白班或夜班+区块名作为字典键值,提取主管助理名单
    
46.                     End If
    
47.                 Next
    
48.             Next
    
49.         Next
    
50.     Next
    
51.     With Sheets("明细表")
    
52.         r = .Cells(Rows.Count, 1).End(3).Row
    
53.         .[k2:m1000] = ""
    
54.         arr = .UsedRange
    
55.         For i = 2 To UBound(arr)
    
56.             s = arr(i, 5)
    
57.             If d1.exists(s) Then
    
58.                 arr(i, 12) = d1(s)     '//K列提取区块名
    
59.             End If
    
60.             区块 = d1(s)
    
61.             rq = Format(Split(arr(i, 10))(0), "m月d日")
    
62.             tim = CDate(Split(arr(i, 10))(1))
    
63.             If tim >= CDate("07:50:00") And tim <= CDate("19:49:59") Then strDay = "白班" Else strDay = "夜班"
    
64.             arr(i, 11) = Month(rq) & "月"     '//月份
    
65.             ttt = today - CLng(CDate(rq))    '//日期差
    
66.             Select Case 区块
    
67.                 Case Is = qk(1)
    
68.                     s = rq & "|" & strDay & "|" & 区块
    
69.                     If ttt > 13 Then
    
70.                         If d.exists(s) Then
    
71.                             arr(i, 13) = d(s)    '//区块是"包装段"的,M列提取主管名单
    
72.                         End If
    
73.                     End If
    
74.                 Case Is = qk(2)
    
75.                     s = rq & "|" & 区块
    
76.                     If ttt > 13 Then
    
77.                         If d.exists(s) Then
    
78.                             arr(i, 13) = d(s)    '//区块是"老化房"的,M列提取主管名单
    
79.                         End If
    
80.                     End If
    
81.                 Case Is = qk(5)
    
82.                     s = rq & "|" & arr(i, 7) & "|" & strDay & "|" & 区块
    
83.                     If ttt > 3 Then
    
84.                         If d.exists(s) Then
    
85.                             arr(i, 13) = d(s)    '//区块是"主板"的,M列提取主管名单
    
86.                         End If
    
87.                     End If
    
88.                 Case Else
    
89.                     s = rq & "|" & arr(i, 7) & "|" & strDay & "|" & 区块
    
90.                     If ttt > 13 Then
    
91.                         If d.exists(s) Then
    
92.                             arr(i, 13) = d(s)      '//区块不是"包装段","老化房"的,M列提取主管名单
    
93.                         End If
    
94.                     End If
    
95.             End Select
    
96.         Next
    
97.         .UsedRange = arr
    
98.     End With
    
99.     Set d = Nothing
    
100.     Set d1 = Nothing
     
101.     Set d2 = Nothing
     
102.     Application.ScreenUpdating = True
     
103.     MsgBox "更新完成！"
     
104. End Sub
     
105. 
     

复制代码

凌云漂流瓶2014

ykcbf1100 发表于 2024-7-18 21:29
代码更新，增加日期比较判断。

大神，太厉害了