macros来结合周末date数据和删除以前的数据

我有数据超过4列与第一列“A”作为date列，然后列“B，C，D”作为数据。 我正在尝试创build一个macros来search周末的date，并将它们添加到周一的数据中，然后从整体数据中删除周末date和数据。 这是我的代码到目前为止：

Sub NamedRange() Dim Rng1 As Range Dim newDate As Integer Dim NumberOfRows As Range Dim MyRange As Range Dim lastRow2 As Variant Set Rng1 = Sheets("Sheet1").Range("A1:A20") Dim date1 As String Dim dat As Date Dim newPrice As Double Set RgSales = Range("MyRange") For i = 1 To RgSales.Rows.Count For j = 1 To RgSales.Columns.Count dat = RgSales.Cells(i, j) date1 = WeekdayName(Weekday(dat)) If (date1 = "Saturday" Or date1 = "Sunday") Then newDate = (RgSales.Cells(i + 1, j + 1).Value) + (RgSales.Cells(i, j + 1).Value) RgSales.Cells(i + 1, j + 1).Value = newDate newPrice = (RgSales.Cells(i + 1, j + 2).Value) + (RgSales.Cells(i, j + 2).Value) RgSales.Cells(i + 1, j + 2).Value = newPrice RgSales.Cells(i, j).Select Selection.Delete RgSales.Cells(i, j + 1).Select Selection.Delete RgSales.Cells(i, j + 2).Select Selection.Delete End If Next j Next i End Sub 

我有问题的范围，我只是希望它结束​​的最后一行数据，并在macros运行后删除所有

Answer 1

通常当你从一个范围中删除行时，你想要向后循环。 一旦你删除一行，它下面的所有行改变相对于范围（第18行成为第17行），可以搞砸你的计数器。 这里有一个例子，我觉得做你想要的。

 Sub ConsolidateWeekends() Dim i As Long Dim j As Long Dim rRng As Range Dim rCell As Range Dim rFound As Range Dim lDayOffset As Long 'Define the range to consolidate Set rRng = Sheet3.Range("A1:A20") 'Always loop backward when deleting rows or 'the counter will get messed up For i = rRng.Rows.Count - 1 To 1 Step -1 Set rCell = rRng.Cells(i, 1) 'Define the offset that will return the Monday following the date If Weekday(rCell.Value) = vbSaturday Then lDayOffset = 2 ElseIf Weekday(rCell.Value) = vbSunday Then lDayOffset = 1 Else lDayOffset = 0 End If If lDayOffset > 0 Then 'Find the cell with the Monday in question Set rFound = rRng.Find(CDate(rCell.Value + lDayOffset), , xlValues, xlWhole) 'if there is a cell with that Monday If Not rFound Is Nothing Then 'Add the current dates B and C values to the Monday B and C values For j = 1 To 2 rFound.Offset(0, j).Value = rFound.Offset(0, j).Value + rCell.Offset(0, j).Value Next j 'Delete the Sat or Sun row rCell.EntireRow.Delete End If End If Next i End Sub