用于合并周末日期数据并删除以前数据的宏

Question

我有超过 4 列的数据，其中第一列“A”作为日期列，然后以下列“B、C、D”作为数据。我正在尝试创建一个宏来搜索周末日期并将它们添加到星期一的数据中，然后从整体数据中删除周末日期和数据。到目前为止，这是我的代码：

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

我的范围有问题，我只想让它在最后一行数据上结束，并在宏运行后删除所有

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