使excel vba根据自定义条件在行之间插入自定义的行数

时间:2016-02-26 02:40:05

标签: excel vba excel-vba

我不知道如何解释这个问题,但我会尽力解释我需要做的事情的逻辑。希望本网站上任何一位出色的人都能提出一些想法:)

我有包含不同项目信息的数据记录。每行包含项目的信息,例如项目名称,创建的日期项目,完成的日期项目,项目完成的估计日期,以及插入/更新估计的时间戳。如果项目具有更新的项目完成的估计日期,则此更新将记录在新行中。这就是excel中数据的样子。

enter image description here

我需要excel检查是否有任何一天过去而且估计的完成日期没有变化(即项目保持正常),然后excel创建行,直到它到达包含更新的那一天。下图显示了我需要如何根据上面的初始行添加自定义行。

enter image description here

请告诉我任何想法..建议使用VBA。

2 个答案:

答案 0 :(得分:0)

我相信这应该能实现你的目标:

Sub FillCompletionDays()

Dim LLoop As Long
Dim LLRow As Long
Dim DateEnd As Date
Dim DateNext As Date
Dim DateNow As Date

LLoop = Range("A:A").Find(what:="Project name").Row + 1
LLRow = Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

If LLRow <= LLoop Then Exit Sub

Do
    'Only proceed if there is a valid date in column E
    If Range("E" & LLoop).Value2 <> vbNullString Then
        DateNow = Range("E" & LLoop).Value2
        DateEnd = Range("C" & LLoop).Value2
        'Check if another date is needed
        If DateEnd > DateNow Then
            'Check if next row is this project
            If Range("A" & LLoop + 1).Value2 = Range("A" & LLoop).Value2 Then
                'Check if a new date is needed
                DateNext = DateSerial(Year(Range("E" & LLoop + 1).Value2), Month(Range("E" & LLoop + 1).Value2), _
                Day(Range("E" & LLoop + 1).Value2))
                If DateNext <> DateNow + 1 Then
                    'Insert a row
                    Rows(LLoop + 1).Insert shift:=xlShiftDown
                    Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2
                    Range("E" & LLoop + 1).Value2 = DateNow + 1
                    Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd"
                    LLRow = LLRow + 1
                End If

            Else
                'Next row is another project; insert a row for this one
                Rows(LLoop + 1).Insert shift:=xlShiftDown
                Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2
                Range("E" & LLoop + 1).Value2 = DateNow + 1
                Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd"
                LLRow = LLRow + 1
            End If
        End If
    End If
    LLoop = LLoop + 1
Loop Until LLoop > LLRow

End Sub

答案 1 :(得分:0)

在编辑@Nick Peranzi后,我的问题的答案符合我的要求我不知道如何标记/提及他但这是他的用户链接 https://stackoverflow.com/users/5472502/nick-peranzi

Sub FillCompletionDays()

Dim LLoop As Long
Dim LLRow As Long
Dim DateEnd As Date
Dim DateNext As Date
Dim DateNow As Date

LLoop = Range("A:A").Find(what:="Project name").Row + 1
LLRow = Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

If LLRow <= LLoop Then Exit Sub

Do
'Only proceed if there is a valid date in column E
If Range("E" & LLoop).Value2 <> vbNullString Then
    DateNow = DateSerial(Year(Range("E" & LLoop).Value2), Month(Range("E" & LLoop).Value2), _
            Day(Range("E" & LLoop).Value2))
    DateEnd = DateSerial(Year(Range("D" & LLoop).Value2), Month(Range("D" & LLoop).Value2), _
            Day(Range("D" & LLoop).Value2))
    'Check if another date is needed
    If DateEnd > DateNow Then
        'Check if next row is this project
        If Range("A" & LLoop + 1).Value2 = Range("A" & LLoop).Value2 Then
            'Check if a new date is needed
            DateNext = DateSerial(Year(Range("E" & LLoop + 1).Value2), Month(Range("E" & LLoop + 1).Value2), _
            Day(Range("E" & LLoop + 1).Value2))
            If DateNext = DateNow Then
            Else
            If DateNext <> DateNow + 1 Then
                'Insert a row
                Rows(LLoop + 1).Insert shift:=xlShiftDown
                Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2
                Range("E" & LLoop + 1).Value2 = DateNow + 1
                Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd"
                LLRow = LLRow + 1
            End If
            End If

        Else
            'Next row is another project; insert a row for this one
            Rows(LLoop + 1).Insert shift:=xlShiftDown
            Range("A" & LLoop + 1 & ":D" & LLoop + 1).Value2 = Range("A" & LLoop & ":D" & LLoop).Value2
            Range("E" & LLoop + 1).Value2 = DateNow + 1
            Range("B" & LLoop + 1 & ": E" & LLoop + 1).NumberFormat = "yyyy-mm-dd"
            LLRow = LLRow + 1
        End If
    End If
End If
LLoop = LLoop + 1
Loop Until LLoop > LLRow


End Sub