VBA_请假
请假
效果
将图一变成图二样式
分析
关于第一个需求:“摆脱手动复制粘贴”，这一步比较好完成，只要找到两个表格的规律，比如A工作薄要取到B工作薄的哪个值，就可以通过for循环加上A表格的某个值等于B表格的某个值来实现，这一步的难点在于两个工作薄是独立的，我们要先打开其中的一个工作薄，然后在此基础上通过VBA代码打开另一上工作薄，进而进行取值。
关于第二个关于筛选的需求，就更好完成了，我只需要手动筛选一次，然后通过宏录制下来就可以得到代码了。
第三个需求是比较难一点的，怎么才能识别到跨天的记录呢？当然这里面也要通过for循环，通过结束时间减去开始时间，看得到的结果是否为0，如果为0的话，那说明就是跨天的，进而现采取动作，那采取怎样的动作？这个思路应该是怎样的？我前期对此一点思路都没有，网上搜索无果，其实我早就预料到了，百度只能解决简单直白的问题，无法对具体问题给出合适的答案。那咨询一下身边的同事，身边的同事都是编程高手，都说这个问题挺简单的，可我就觉得这个问题这么难，怎么办？早知道就不接这个工作了，就干脆利落的说自己不会做就完了，兜兜转转问题还是没解决，又回到了原点，自己只能硬着头皮想了，但自己跨出这一步的时候，发现这个问题好像也没有那么困难。
强调一点，我们是一行一行处理的，开始时间和结束时间前面的字符直接复制就可以了，也不需要处理了，需要处理的就仅是开始时间和结束时间，思路是这样的，通过for循环遍历整张表格，如果是结束时间减去开始时间不等于0，那就进入if判断，判断什么呢？我们一点点来看，我们先看开始时间，如果结束时间减去开始时间等于0，那么开始时间就要取得取值不变，如果结束减去开始时间不等于0，如果不等于0的话，第一次循环开始时间也要等于原值，但后续的开始时间就可以是固定的八点半。
for i = 1 to 结束时间 - 开始时间 + 1
if i = 1 then
开始时间 = 原值
else
开始时间 = 8:30
next
我们用同样的思路来处理结束时间
for i = 1 to 结束时间 - 开始时间 + 1
if 第一次和最后一次是原值
结束时间 = 原值
其它时候是定值
结束时间 = 15：30
next
那将以上两者同时写出来，是这样的：
for i = 1 to 结束 - 开始 + 1
if i = 1 then
开始时间=原值
else
开始时间=8:30
if i = 1 then
结束时间=原值
elseif i = 结束 - 开始 +1
结束时间=原值
else
结束时间=17:30
next
以上就是代码最关键的部分，我们再来处理一些边边角角的问题，这个处理应该是一行一行的处理，所以最外侧一定要有一个for来遍历整个表格，然后里面还要嵌套上述内容，那整体的框架应该是：
for 遍历要处理的内容
for i = 结束 - 开始 + 1
……
next
next
还要再填充一些东西，仅仅上述内容并不能完成我们想要结果，每循环一行，都要将一行的内容放置到一个新的地方，在原地修改容易把自己搞晕，那新的地方就需要指定，而且新的地方要不断的递增。
for 遍历要处理的内容
k = 一个新值
for i = 结束 - 开始 + 1
……
next
cp 原数据的固定值 到 新地方
变化的值进行拼接
k = k + 1
next
好，那我们拿一个简单的小例子来练一练，简单的写一写，不用把代码写全，把意思写出来就好
k = 10
for i = 2 to 6
for j = range(ei) - range(di) + 1
if j = 1 then
start = split.range(di)
else
start = 8:30
endif
if j = 1 then
end = start = split.range(ei)
elseif j = range(ei) - range(di) + 1
end = start = split.range(ei)
else
end = 17:30
endif
cp range(a i):range(ci) k
range(dk) = ? 这里的年份应该如何处理呢？刚才忘记说了，这里面的年份要等于原来的年份+结束开始之差再减去1 然后拼接 start
range(dk) = ? 这里的年份应该如何处理呢？刚才忘记说了，这里面的年份要等于原来的年份+结束开始之差再减去1 然后拼接 end
k = k + 1
next
next
代码
Sub 请假_第一步()
Excel.Application.DisplayAlerts = False
' 自动删除第四行
Rows(4).Select
Selection.EntireRow.Delete
'变量wb代表一个工作表，将这个变量声明；
Dim wb As Workbook
'将打开的表赋值给wb这个变量
Set wb = Workbooks.Open("c:\data\钉钉-请假.xlsx")
For L = Sheets(1).Range("a65536").End(xlUp).Row To 1 Step -1
If Range("C" & L) = "已撤销" Then
Range("C" & L).Select
Selection.EntireRow.Delete
End If
If Range("D" & L) = "拒绝" Then
Range("D" & L).Select
Selection.EntireRow.Delete
End If
Next
'将当前活动表格当中不需要的列全部删除；
Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,I:I,K:K,M:M,l:l,N:N,R:R,S:S,T:T").Select
Range("T1").Activate
Selection.Delete Shift:=xlToLeft
'保存表格，如果没有这一步的话，前面的操作不会保存；
ActiveWorkbook.Save
'关闭表格
wb.Close
' 恢复提醒
Excel.Application.DisplayAlerts = True
Dim str As String
'将上述处理好的表格复制到当前工作薄里面，在这里面会当做是sheet2
For i = 1 To Range("a65535").End(xlUp).Row
Set wb = Workbooks.Open("c:\data\钉钉-请假.xlsx")
wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
wb.Close
If str = "" Then
Exit For
End If
' 删除sheet2表格只留下sheet1表格
Next
Sheets(2).Select
t = Sheets(2).Range("a65536").End(xlUp).Row
Range("a2:e" & t).Copy Sheets(1).Range("a4")
Excel.Application.DisplayAlerts = False
Sheets(2).Delete
Excel.Application.DisplayAlerts = True
q = Sheets(1).Range("a65536").End(xlUp).Row
For i = q To 4 Step -1
k = Len(Range("D" & i).Value)
If k = 10 Then
Rows(i).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
MsgBox "标黄的行不符合要求，如果您想删除标黄的行，请继续执行第二步"
End Sub
Sub 请假_第二步()
Excel.Application.DisplayAlerts = False
q = Sheets(1).Range("a65536").End(xlUp).Row
For i = 4 To q
k = Len(Range("D" & i).Value)
If k = 10 Then
Range("d" & i).Select
Selection.EntireRow.Delete
End If
Next
Excel.Application.DisplayAlerts = True
MsgBox "已经为您把标黄的行全部删除了，请继续执行第三步"
End Sub
Sub 请假_第三步自动展开跨天()
Dim i, j, k
Dim strStart, strEnd
k = 1000
For i = 4 To Range("a65535").End(xlUp).Row
For j = 1 To DateValue(Range("e" & i)) - DateValue(Range("d" & i)) + 1
If j = 1 Then
strStart = Split(Range("d" & i), " ")(1)
Else
strStart = "08:30"
End If
If j = DateValue(Range("e" & i)) - DateValue(Range("d" & i)) + 1 Then
strEnd = Split(Range("e" & i), " ")(1)
Else
strEnd = "17:30"
End If
Range("a" & i & ":c" & i).Copy Range("a" & k)
Range("d" & k) = Format(DateValue(Range("d" & i)) + j - 1, "yyyy-mm-dd ") & strStart
Range("e" & k) = Format(DateValue(Range("d" & i)) + j - 1, "yyyy-mm-dd ") & strEnd
k = k + 1
Next
Next
MsgBox "已经把跨天请假的自动展开了！，可以继续执行第四步了！！！"
End Sub
Sub 请假_第四步删除辅助数据()
Excel.Application.DisplayAlerts = False
Rows("4:999").Select
Selection.Delete Shift:=xlUp
Excel.Application.DisplayAlerts = True
'将表格内的所有的包含离职关键字的替换为空
Columns("A:A").Select
Selection.Replace What:="(已离职)", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'将哺乳假改成哺乳时间假
Columns("C:C").Select
Selection.Replace What:="哺乳假", Replacement:="哺乳时间假", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'自动调整B和C的列宽
Columns("B:C").Select
Selection.ColumnWidth = 19.88
q = Sheets(1).Range("a65536").End(xlUp).Row
For i = 4 To q
k = Len(Range("a" & i).Value)
If k > 10 Then
Rows(i).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
MsgBox "删除了辅助数据，所有已离职替换为空，哺乳假替换为哺乳时间假！！，好了，大功告成，现在这请假表已经处理完成了，如果发现工号的异常的行，会标黄提醒您的"
End Sub
使用步骤
所有的日期格式必须为2020-01-01 19:30，如果有的有请假时间里面只有年月月日，却没有时分，在第二步的时候将会卡住，无法继续向下执行，所以在执行第二步之前，请先确认一下时间格式。
- 将钉钉请假的工作簿放置到C盘的data文件夹，如果没有data文件夹就新建一个，文件必须命名为“钉钉-请假”（注意，没有双引号）
- 进入金蝶的模板表，在excel的的功能区当中依次点击“开发工具—-visual basic”—插入—-模块
- 在空白区域粘贴代码，然后关闭对话框；
- 按步骤执行
