|
|
本帖最后由 ykcbf1100 于 2024-7-18 11:58 编辑
老化房单独建区域修改代码- Sub ykcbf() '//2024.7.18 https://club.excelhome.net/thread-1697422-1-1.html?_dsign=ff819a2f
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- Set d2 = CreateObject("Scripting.Dictionary")
- Set sh = ThisWorkbook.Sheets("明细表")
- arr = Sheets("区域表").UsedRange
- For i = 2 To UBound(arr)
- For j = 1 To UBound(arr, 2)
- s = arr(i, j)
- If s <> Empty Then
- d1(s) = arr(1, j) '//用工序去提取区块
- End If
- Next
- Next
- st = "生产一部工业园内销车间拉线排布"
- qk = [{"包装段","老化房","装配段","测试段","主板"}] '//区块数组
- With Sheets("排班表")
- arr = .UsedRange
- For i = 1 To UBound(arr)
- If InStr(arr(i, 1), st) Then k = k + 1: d2(k) = i '//分块处理
- Next
- End With
- For k = 1 To d2.Count
- r1 = d2(k)
- If k = d2.Count Then r2 = UBound(arr) Else r2 = d2(k + 1) - 1 '//r1:区块第一行,r2:区块最后一行
- rq = Replace(arr(r1, 1), st, "")
- rq = Mid(rq, 2, Len(rq) - 2) '//日期提取
- zg = Split(arr(r1 + 2, 9), Chr(10)) '//区块"包装段","老化房"提取的白班、夜班主管助理
- For x = 0 To UBound(zg)
- b = Split(zg(x), "：")
- s = rq & "|" & b(0) & "|" & qk(1) '//用日期+白班或夜班+区块名作为字典键值,提取包装主管助理名单
- d(s) = b(1)
- Next
- s = rq & "|" & qk(2) '//用日期+区块名作为字典键值,提取老化房主管助理名单
- d(s) = arr(r1 + 2, 10)
- For j = 5 To 6
- dy = Replace(arr(r1 + 1, j), " ", "") '//提取白班或夜班
- For i = r1 + 2 To r2
- cx = Split(arr(i, 2), Chr(10))(0) '//提取产线名
- For y = 3 To 5
- If arr(i, j) = 1 Then
- s = rq & "|" & cx & "|" & dy & "|" & qk(y)
- d(s) = arr(i, j + 2) '//区块不是"包装段","老化房"的,用日期+产线+白班或夜班+区块名作为字典键值,提取主管助理名单
- End If
- Next
- Next
- Next
- Next
- With Sheets("明细表")
- r = .Cells(Rows.Count, 1).End(3).Row
- .[k2:l1000] = ""
- arr = .UsedRange
- For i = 2 To UBound(arr)
- s = arr(i, 5)
- If d1.exists(s) Then
- arr(i, 11) = d1(s) '//K列提取区块名
- End If
- 区块 = d1(s)
- rq = Format(Split(arr(i, 10))(0), "m月d日")
- tim = CDate(Split(arr(i, 10))(1))
- If tim >= CDate("07:50:00") And tim <= CDate("19:49:59") Then strDay = "白班" Else strDay = "夜班"
- Select Case 区块
- Case Is = qk(1)
- s = rq & "|" & strDay & "|" & 区块
- If d.exists(s) Then
- arr(i, 12) = d(s) '//区块是"包装段"的,L列提取主管名单
- End If
- Case Is = qk(2)
- s = rq & "|" & 区块
- If d.exists(s) Then
- arr(i, 12) = d(s) '//区块是"老化房"的,L列提取主管名单
- End If
- Case Else
- s = rq & "|" & arr(i, 7) & "|" & strDay & "|" & 区块
- If d.exists(s) Then
- arr(i, 12) = d(s) '//区块不是"包装段","老化房"的,L列提取主管名单
- End If
- End Select
- Next
- .UsedRange = arr
- End With
- Set d = Nothing
- Set d1 = Nothing
- Set d2 = Nothing
- Application.ScreenUpdating = True
- MsgBox "更新完成！"
- End Sub
|
评分
-
1
查看全部评分
-
|
楼主: 凌云漂流瓶2014
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2024-7-18 11:19
