删除行偏移量为1

时间:2016-12-14 22:57:14

标签: excel excel-vba excel-2010 vba

我正在尝试编写一个循环通过一组包含3列的速率的宏: rate_table,rate_date,rate

这是我到目前为止所拥有的。我想我只需要命令删除行

Private Const RATE_TABLE_COL = 1
Private Const RATE_DATE_COL = 2
Private Const RATE_COL = 3

Sub RemoveDuplicateRates()
    Dim iLastRow As Long, iRow As Long, sThisRate As String, sPrevRate As String

    'Find the last row (in column A) with data.
    iLastRow = shtSource.Range("A:A").Find("*", searchdirection:=xlPrevious).Row

    If iLastRow < 2 Then
        MsgBox "No data to process!", vbCritical
        Exit Sub
    End If

    sThisRate = ""
    sPrevRate = ""

    For iRow = iLastRow To 1 Step -1
        sPrevRate = sThisRate
        sThisRate = Cells(iRow, 1)
        If sThisRate = sPrevRate Then
            If Cells(iRow, RATE_COL) = Cells(iRow - 1, RATE_COL) Then
                ' need code here to delete row offset by 1 from iRow
            End If
        End If
    Next iRow
End Sub

1 个答案:

答案 0 :(得分:2)

这是最终的工作代码:

Private Const RATE_TABLE_COL = 1
Private Const RATE_DATE_COL = 2
Private Const RATE_COL = 3

Sub RemoveDuplicateRatesRev2()
    Dim iLastRow As Long, iRow As Long, sThisRate As String, sPrevRate As String, shtSource As Worksheet

    Set shtSource = ActiveSheet

    'Find the last row (in column A) with data.
    iLastRow = shtSource.Range("A:A").Find("*", searchdirection:=xlPrevious).Row

    If iLastRow < 2 Then
        MsgBox "No data to process!", vbCritical
        Exit Sub
    End If

    sThisRate = ""
    sPrevRate = ""

    For iRow = iLastRow To 1 Step -1
        sPrevRate = sThisRate
        sThisRate = shtSource.Cells(iRow, 1)
        If sThisRate = sPrevRate Then
            If shtSource.Cells(iRow, RATE_COL) = shtSource.Cells(iRow + 1, RATE_COL) _
                And shtSource.Cells(iRow, RATE_DATE_COL) < shtSource.Cells(iRow + 1, RATE_DATE_COL) Then
                ' need code here to delete row offset by 1 from iRow
                shtSource.Cells(iRow + 1, RATE_COL).EntireRow.Delete
            End If
        End If
    Next iRow
End Sub
相关问题