我不知道如何解释这个问题,但我会尽力解释我需要做的事情的逻辑。希望本网站上任何一位出色的人都能提出一些想法:)
我有包含不同项目信息的数据记录。每行包含项目的信息,例如项目名称,创建的日期项目,完成的日期项目,项目完成的估计日期,以及插入/更新估计的时间戳。如果项目具有更新的项目完成的估计日期,则此更新将记录在新行中。这就是excel中数据的样子。
我需要excel检查是否有任何一天过去而且估计的完成日期没有变化(即项目保持正常),然后excel创建行,直到它到达包含更新的那一天。下图显示了我需要如何根据上面的初始行添加自定义行。
请告诉我任何想法..建议使用VBA。
答案 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