[已解决]如何自动按班表自动排班？/

jian82372387

如何自动按班表自动排班？/要求在附件有说明

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-5-30 15:17

jian82372387 发表于 2021-5-30 09:51
有哪位大哥能帮忙解决一下下吗？

Sub demo()
   Set d = CreateObject("Scripting.Dictionary")
   a = Sheets("班表").UsedRange
   For j = 3 To UBound(a, 2)
      Key = Format(a(1, j), "M月d日班表")
      Set d(Key) = CreateObject("Scripting.Dictionary")
      For i = 2 To UBound(a)
         If a(i, j) > 0 Then d(Key)(a(i, j) & "") = i
      Next
   Next
   With Sheets(2)
      b = .UsedRange
      For i = 1 To UBound(b)
         v = Replace(b(i, 1), "A", "")
         r = d(.Name)(v)
         If r Then
            b(i, 5) = a(r, 1)
            b(i, 6) = a(r, 2)
         End If
      Next
      .[a1].Resize(UBound(b), UBound(b, 2)) = b
   End With
End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

jian82372387

能有办法用字典解决吗？

jian82372387

哪位大哥能帮忙解决一下？谢谢

jian82372387

有哪位大哥能帮忙解决一下下吗？

cutecpu

jian82372387 发表于 2021-5-30 09:51
有哪位大哥能帮忙解决一下下吗？

Sub demo()
   Set d = CreateObject("Scripting.Dictionary")
   a = Sheets("班表").UsedRange
   For j = 3 To UBound(a, 2)
      Key = Format(a(1, j), "M月d日班表")
      Set d(Key) = CreateObject("Scripting.Dictionary")
      For i = 2 To UBound(a)
         If a(i, j) > 0 Then d(Key)(a(i, j) & "") = i
      Next
   Next
   With Sheets(2)
      b = .UsedRange
      For i = 1 To UBound(b)
         v = Replace(b(i, 1), "A", "")
         r = d(.Name)(v)
         If r Then
            b(i, 5) = a(r, 1)
            b(i, 6) = a(r, 2)
         End If
      Next
      .[a1].Resize(UBound(b), UBound(b, 2)) = b
   End With
End Sub

祝順心，南無阿彌陀佛！

jian82372387

cutecpu 发表于 2021-5-30 15:17
Sub demo()
   Set d = CreateObject("Scripting.Dictionary")
   a = Sheets("班表").UsedRange

十分感谢