时间轴-遍历第一个和最后一个给定之间的所有日期,如果找不到则将日期添加到列中 [英] Timeline - loop through all dates between first and last given and add date to column if not found
问题描述
我在A,B,C列中拥有什么:
what I have in columns A, B, C:
日期小时名称
2016年1月3日8.0约翰
2016年2月3日8,0约翰
2016年8月3日7.5约翰
2016年8月3日2,0查尔斯
2016年8月3日2,0威廉
2016年10月3日3,5查尔斯
2016年11月3日3,7查尔斯
14/03/2016 2,2查尔斯
15/03/2016 8,0约翰
2016/03/16 8.0约翰
Date Hours Name
01/03/2016 8,0 John
02/03/2016 8,0 John
08/03/2016 7,5 John
08/03/2016 2,0 Charles
08/03/2016 2,0 William
10/03/2016 3,5 Charles
11/03/2016 3,7 Charles
14/03/2016 2,2 Charles
15/03/2016 8,0 John
16/03/2016 8,0 John
我想在另一张纸的A,B,C列中显示什么:
what I want in column A, B, C in another sheet:
日期小时名称
2016年1月3日8.0约翰
2016年2月3日8,0约翰
2016/03/03 0,0-
2016年4月3日0,0-
2016年5月3日0,0-
2016年6月3日0,0-
2016年7月3日0,0-
2016年8月3日7.5约翰
2016年8月3日2,0查尔斯
2016年8月3日2,0威廉
2016年9月3日0,0-
2016年10月3日3,5查尔斯
2016年11月3日3,7查尔斯
2016年12月3日0,0-
13/03/2016 0,0-
14/03/2016 2,2查尔斯
15/03/2016 8,0约翰
2016/03/16 8.0约翰
Date Hours Name
01/03/2016 8,0 John
02/03/2016 8,0 John
03/03/2016 0,0 -
04/03/2016 0,0 -
05/03/2016 0,0 -
06/03/2016 0,0 -
07/03/2016 0,0 -
08/03/2016 7,5 John
08/03/2016 2,0 Charles
08/03/2016 2,0 William
09/03/2016 0,0 -
10/03/2016 3,5 Charles
11/03/2016 3,7 Charles
12/03/2016 0,0 -
13/03/2016 0,0 -
14/03/2016 2,2 Charles
15/03/2016 8,0 John
16/03/2016 8,0 John
它必须使用任何给定的日期,时间和名称!
It has to work with any given dates, hours and names!
请帮助我,我真的需要这个!
Please help I really need this!
Sub proj0()
Dim lRow As Long
Dim Data1, Data2 As Date
Dim C1, C2 As String
Folha11.Select
Columns("a:c").Select
Selection.Copy
Folha13.Select
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.Sort _
Key1:=Range("a2"), Order1:=xlAscending, _
key2:=Range("c2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
lRow = 2
Do While (Cells(lRow, 1) <> "")
C1 = Cells(lRow, "c")
C2 = Cells(lRow + 1, "c")
Data1 = Cells(lRow, "a")
Data2 = Cells(lRow + 1, "a")
If (Data2 - Data1 > 1) Then
ActiveCell.EntireRow.Insert shift:=xlDown
Cells(lRow + 1, "a").Value = Data1 + 1
Cells(lRow + 1, "b").Value = 0
Cells(lRow + 1, "c").Value = "-"
Else
lRow = lRow + 1
End If
Loop
Range("a:c").Columns.AutoFit
Folha13.Select
我相信我已经接近了,但无法弄清楚插入部分
I believe i'm close but cant figure the insert part
推荐答案
这是您的建议:
Sub timeline()
Dim i As Long
Dim ws As Worksheet
Dim ts As Worksheet
Set ws = Sheets("Sheet15") 'Change to your Output Sheet
Set ts = Sheets("Sheet14") 'Change to your data sheet
With ws
i = ts.Range("A" & ts.Rows.Count).End(xlUp).Row
ts.Range("A1:C" & i).Copy .Range("A1")
.Range("A1:C" & i).Sort Key1:=.Range("A2"), Order1:=xlAscending, _
key2:=.Range("C2"), Order2:=xlAscending, _
Header:=xlYes
Do Until i = 2
If .Cells(i, 1).Value2 = .Cells(i - 1, 1).Value2 Or .Cells(i, 1).Value2 = .Cells(i - 1, 1).Value2 + 1 Then
i = i - 1
Else
.Rows(i).Insert
.Cells(i, 1).Value = .Cells(i + 1, 1).Value2 - 1
.Cells(i, 2).Value = 0#
.Cells(i, 3).Value = "--"
End If
Loop
End With
End Sub
Sheet14之前:
Sheet14 Before:
Sheet15之后:
Sheet15 After:
这篇关于时间轴-遍历第一个和最后一个给定之间的所有日期,如果找不到则将日期添加到列中的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!