在范围内的条件下添加行

时间:2018-06-26 17:11:11

标签: excel vba excel-vba

我恳请您在这个问题上帮助我。

请在下面查看数据:

名称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 

结束子

谢谢大家!

1 个答案:

答案 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