用於合併週末日期數據和刪除以前數據的宏

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