1

我有超过 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

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

4

1 回答 1

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
于 2012-07-25T18:31:04.893 回答