Excel精英培训网

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

[已解决]按照结果转换

[复制链接]
发表于 2016-12-12 17:47 | 显示全部楼层 |阅读模式
如附件,要求写在里面,搞的我很头疼,希望高手解答
最佳答案
2016-12-13 10:17
未考虑双周末及法定假日。
  1. Sub 生成()
  2.     arr = Sheets(1).[a1].CurrentRegion
  3.     [a2:t1000].ClearContents
  4.     ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  5.     For i = 2 To UBound(arr)
  6.         If arr(i, 4) = "同意" Then
  7.             ks = arr(i, 16): js = arr(i, 17)     '开始、结束
  8.             d = DateDiff("d", ks, js)       '相隔天数
  9.             For k = 0 To d
  10.                 n = n + 1
  11.                 For j = 1 To UBound(arr, 2)
  12.                     brr(n, j) = arr(i, j)
  13.                 Next
  14.                 If d > 0 Then
  15.                     brr(n, 17) = IIf(k < d, DateSerial(Year(ks), Month(ks), Day(ks + k)) & " 16:30", js) '结束时间(16.30或最后一天结束时间)
  16.                     If k >= 1 Then
  17.                         brr(n, 16) = DateSerial(Year(ks), Month(ks), Day(ks) + k) & " 08:00"    '8点
  18.                         brr(n, 18) = 8
  19.                     End If
  20.                     If k = 0 Or k = d Then brr(n, 18) = Int(24 * (TimeValue(brr(n, 17)) - TimeValue(brr(n, 16))))
  21.                 End If
  22.             Next
  23.         End If
  24.     Next
  25.     [a2].Resize(n, UBound(arr, 2)) = brr
  26.     ActiveSheet.Columns.AutoFit
  27. End Sub
复制代码

钉钉请假管理.rar

10.2 KB, 下载次数: 11

发表于 2016-12-13 10:17 | 显示全部楼层    本楼为最佳答案   
未考虑双周末及法定假日。
  1. Sub 生成()
  2.     arr = Sheets(1).[a1].CurrentRegion
  3.     [a2:t1000].ClearContents
  4.     ReDim brr(1 To 1000, 1 To UBound(arr, 2))
  5.     For i = 2 To UBound(arr)
  6.         If arr(i, 4) = "同意" Then
  7.             ks = arr(i, 16): js = arr(i, 17)     '开始、结束
  8.             d = DateDiff("d", ks, js)       '相隔天数
  9.             For k = 0 To d
  10.                 n = n + 1
  11.                 For j = 1 To UBound(arr, 2)
  12.                     brr(n, j) = arr(i, j)
  13.                 Next
  14.                 If d > 0 Then
  15.                     brr(n, 17) = IIf(k < d, DateSerial(Year(ks), Month(ks), Day(ks + k)) & " 16:30", js) '结束时间(16.30或最后一天结束时间)
  16.                     If k >= 1 Then
  17.                         brr(n, 16) = DateSerial(Year(ks), Month(ks), Day(ks) + k) & " 08:00"    '8点
  18.                         brr(n, 18) = 8
  19.                     End If
  20.                     If k = 0 Or k = d Then brr(n, 18) = Int(24 * (TimeValue(brr(n, 17)) - TimeValue(brr(n, 16))))
  21.                 End If
  22.             Next
  23.         End If
  24.     Next
  25.     [a2].Resize(n, UBound(arr, 2)) = brr
  26.     ActiveSheet.Columns.AutoFit
  27. End Sub
复制代码

钉钉请假管理.rar

21.5 KB, 下载次数: 5

回复

使用道具 举报

发表于 2017-8-8 19:45 | 显示全部楼层
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 07:05 , Processed in 0.314051 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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