EXCEL VBA将一周的数据复制到不同的工作表中

Question

>我在工作簿中有 2 张纸，一张包含所有数据("hdagarb"(，另一张是"摘要"。在数据手册中，第 2 列包含名称，第 5 列包含日期。这些是我关注的列。我想获取截至 6 月 9 日的一周内的所有行，然后复制第 2 列中的名称和第 5 列中的日期并将其粘贴到我的摘要表中。目前，我什至无法让它复制并粘贴第 2 列名称。这是我的代码：

Sub finddata()

Dim todaysdate As Date
Dim thisweek As Date
Dim lastweek As Date
Dim finalrow As Long
Dim Rdate As Date
Dim i As Long
Sheets("Summary").Range("H5:H1000").ClearContents
todaysdate = Date
thisweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate
lastweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate - 7

finalrow = Sheets("HDAGarb").Range("A100000").End(xlUp).Row

For i = 2 To finalrow
Rdate = Sheets("hdagarb").Cells(i, 5)
If Rdate > lastweek Then
Sheets("hdagarb").Cells(i, 2).Copy
Sheets("Summary").Range("H100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i

Worksheets("summary").Activate
Worksheets("summary").Range("H5").Select
End Sub

第 5 列中的源数据如下所示

02-Jun-2017  
-  
-  
-  
-  
12-Apr-2017  
01-May-2017  

我希望脚本忽略没有日期("-"(的条目。

Answer 1

仅当 E 列中有有效日期时，以下代码才会执行复制：

Sub finddata()
Dim todaysdate As Date
Dim thisweek As Date
Dim lastweek As Date
Dim finalrow As Long
Dim newRow As Long
Dim Rdate As Date
Dim i As Long
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
todaysdate = Date
thisweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate
lastweek = (7 - Weekday(todaysdate, vbSaturday)) + todaysdate - 7
Set srcSheet = Worksheets("HDAGarb")
Set dstSheet = Worksheets("Summary")
finalrow = srcSheet.Range("A" & srcSheet.Rows.Count).End(xlUp).Row
dstSheet.Range("H5:H" & dstSheet.Cells(dstSheet.Rows.Count, "H").End(xlUp).Row).ClearContents
newRow = 4
For i = 2 To finalrow
If IsDate(srcSheet.Cells(i, "E").Value) Then
Rdate = CDate(srcSheet.Cells(i, 5).Value)
If Rdate > lastweek Then 'or If Rdate > lastweek And Rdate <= thisweek Then  '???
newRow = newRow + 1
srcSheet.Cells(i, "B").Copy
dstSheet.Cells(newRow, "H").PasteSpecial xlPasteFormulasAndNumberFormats
'Not sure whether you wanted the next two lines
srcSheet.Cells(i, "E").Copy
dstSheet.Cells(newRow, "I").PasteSpecial xlPasteFormulasAndNumberFormats
End If
End If
Next i
dstSheet.Activate
dstSheet.Range("H5").Select
End Sub

我还对其进行了更改以跟踪摘要表中正在写入的行，以便，如果 HDAGarb 工作表中的一个名称为空，它仍将复制它和相关日期。 (如果您不必继续重新计算最后一行，它也会更快。