我恳请您在这个问题上帮助我。
请在下面查看数据:
名称StartDate EndDate
约翰2016年7月17日2017年7月17日
约翰17.07.2017 17.07.2018
玛丽亚01.08.2017 01.08.2018
克里斯05.01.2018 05.01.2019
工人及其工作年限。工作结束后,我需要为工人添加新行。例如,当日期> 2018年7月17日时,我需要为约翰添加新行。 (日期=今天的公式)
这看起来很简单,但这是我的假期模块的一部分。
我开始写这样的代码。
Sub AddWorkingYearLine()
Dim WorVac As Worksheet: Set WorVac = Worksheets("WorkerVacation")
Dim i As Long
Dim LRow As Long
Dim LCol As Long
Dim MyTable As Variant
LRow = Range("A1048576").End(xlUp).Row: LCol = Range("XFD4").End(xlToLeft).Column
MyTable = Range(Cells(4, 1), Cells(LRow, LCol))
For i = 1 To UBound(MyTtable, 1)
If Branches.Range("C" & i) > Range("G1") Then 'Range("G1") = today formula
End If
Next i
结束子
谢谢大家!
答案 0 :(得分:1)
这是我对您要求的解释。如果当前行的“ C”列在今天之前出现,则它将插入一行,将当前行复制到该新行中,然后在这些日期上增加年份。
Sub AddWorkingYearLine()
Dim i As Long
For i = Cells(Rows.count, "A").End(xlUp).row To 4 Step -1
'make sure it's not an "old entry"
If Cells(i, "A").Value2 <> Cells(i + 1, "A").Value2 Then
'if today occurs after "end date" then
If Date > CDate(Cells(i, "C").value) And Len(Cells(i, "C").Value2) > 0 Then
'insert row
Rows(i + 1).Insert Shift:=xlShiftDown
'copy row down
Rows(i + 1).value = Rows(i).value
'update dates
Cells(i + 1, "B").value = Cells(i, "C").value
Cells(i + 1, "C").value = DateAdd("yyyy", 1, CDate(Cells(i, "C").value))
End If
End If
Next i
End Sub