Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3769|回复: 7

[已解决]复杂点的排班表

[复制链接]
发表于 2014-6-3 23:44 | 显示全部楼层 |阅读模式
本帖最后由 neoplanz 于 2014-6-3 23:45 编辑

目前的情况是三个校区,北校区和南校区需要白班晚班值班,东校区白班值班,需要生成短信内容,姓名有重复

首先感谢grf1973对上一个问题的解答!
最佳答案
2014-6-4 14:59
请看附件。
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2014-6-3 23:46 | 显示全部楼层
附件如下

值班表.rar

3.15 KB, 下载次数: 26

回复

使用道具 举报

 楼主| 发表于 2014-6-4 10:53 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2014-6-4 10:53 | 显示全部楼层
grf1973快进来
回复

使用道具 举报

 楼主| 发表于 2014-6-4 14:16 | 显示全部楼层
如果第一个功能,再生成一个excel文件比较困难的话,暂时先放放,
先解决第二个功能,就是生成发短信内容,grf1973在上一个帖子里有类似的解决办法,但本人对这个实在是一无所知,所以还是不能解决,麻烦帮忙再看看,
多谢多谢!!!
回复

使用道具 举报

发表于 2014-6-4 14:59 | 显示全部楼层
这个没什么难的,就是比较烦,对来对去眼都花了。
  1. Sub 生成短信()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Set d1 = CreateObject("scripting.dictionary")
  4.     arr = Sheets("通讯录").[a1].CurrentRegion  '通讯录
  5.     For i = 1 To UBound(arr)
  6.         d(arr(i, 1) & arr(i, 2)) = arr(i, 3)     '姓名+部门为key,短号为item
  7.         d1(arr(i, 1) & arr(i, 2)) = arr(i, 4)    '姓名+部门为key,长号为item
  8.     Next
  9.     Dim LongTel
  10.     With Sheets("全校")
  11.         arr = .[a1].CurrentRegion
  12.         ReDim brr(1 To UBound(arr), 1 To 9)
  13.         For i = 4 To UBound(arr)
  14.             LongTel = ""
  15.             n = n + 1
  16.             brr(n, 1) = arr(i, 1)   '日期
  17.             brr(n, 2) = arr(i, 2)   '星期
  18.             For j = 3 To 7
  19.                 m = 4 * (j - 3) + 3
  20.                 k1 = arr(i, m) & arr(i, m + 1): k2 = arr(i, m + 2) & arr(i, m + 3)
  21.                 If d.exists(k1) Then brr(n, j) = arr(i, m) & d(k1)
  22.                 If d.exists(k2) Then brr(n, j) = brr(n, j) & Chr(10) & arr(i, m + 2) & d(k2)  '姓名+短号
  23.             Next
  24.             
  25.             For k = 1 To 4    '今日晚班长号
  26.                 p = IIf(k = 1, 7, IIf(k = 2, 9, IIf(k = 3, 15, 17)))
  27.                 xkey = arr(i, p) & arr(i, p + 1)
  28.                 If d1.exists(xkey) Then LongTel = LongTel & "," & d1(xkey)
  29.             Next
  30.             If i < UBound(arr) Then    '明日白班长号
  31.                 For k = 1 To 6
  32.                     p = IIf(k = 1, 3, IIf(k = 2, 5, IIf(k = 3, 11, IIf(k = 4, 13, IIf(k = 5, 19, 21)))))
  33.                     xkey = arr(i + 1, p) & arr(i + 1, p + 1)
  34.                     If d1.exists(xkey) Then LongTel = LongTel & "," & d1(xkey)
  35.                 Next
  36.             End If
  37.             brr(n, 8) = "'" & Mid(LongTel, 2)
  38.         Next
  39.         
  40.         For i = 1 To n           '短信内容
  41.             a1 = "": a2 = "": a3 = "": a4 = "": a5 = ""
  42.             If brr(i, 4) <> "" Then a1 = "    今天晚班值班的北校区人员是(" & Replace(brr(i, 4), Chr(10), ",") & ")"
  43.             If brr(i, 6) <> "" Then a2 = ",南校区人员是(" & Replace(brr(i, 6), Chr(10), ",") & ")" & Chr(10)
  44.             If i < n Then
  45.                 If brr(i + 1, 3) <> "" Then a3 = "    明天白天值班的北校区人员是(" & Replace(brr(i + 1, 3), Chr(10), ",") & ")"
  46.                 If brr(i + 1, 5) <> "" Then a4 = ",南校区人员是(" & Replace(brr(i + 1, 5), Chr(10), ",") & ")"
  47.                 If brr(i + 1, 7) <> "" Then a5 = ",东校区人员是(" & Replace(brr(i + 1, 7), Chr(10), ",") & ")"
  48.             End If
  49.             brr(i, 9) = a1 & a2 & a3 & a4 & a5
  50.         Next
  51.     End With
  52.     With Sheet3
  53.         .Rows("3:100").ClearContents
  54.         .[a3].Resize(n, 9) = brr
  55.         .Rows("3:" & 3 + n).AutoFit
  56.     End With
  57. End Sub
复制代码
回复

使用道具 举报

发表于 2014-6-4 14:59 | 显示全部楼层    本楼为最佳答案   
请看附件。

值班表.rar

16.04 KB, 下载次数: 36

回复

使用道具 举报

 楼主| 发表于 2014-6-4 15:15 | 显示全部楼层
牛人!顶礼膜拜,拜你为师可否?
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 20:41 , Processed in 0.574875 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表