VBA - 删除上方的行或下方的行

时间:2014-10-15 01:44:44

标签: excel vba excel-vba ms-office

我有一张Excel表格,其结构如下:

我需要做的是删除整个记录,如果它的类型A或类型B是= 0.例如,对于记录1,我需要删除A& B因为B = 0。

enter image description here

我有以下代码:

  Sub Loop_Example()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


With ActiveSheet


    .Select


    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView


    .DisplayPageBreaks = False


    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row


    For Lrow = Lastrow To Firstrow Step -1


        With .Cells(Lrow, "B")

            If Not IsError(.Value) Then

                If .Value = "0" Then .EntireRow.Delete

            End If

        End With

    Next Lrow

End With

ActiveWindow.View = ViewMode
With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With

End Sub

因此,我想要做的是添加逻辑以删除整个行(如果值为0)以及上面或下面的行取决于它的'类型'。

感谢。

2 个答案:

答案 0 :(得分:0)

这应该有效。

Sub pDeleteRow()

        Dim wksData             As Worksheet
        Dim rngCell             As Range

        Dim lngCounter          As Long
        Dim lngTotalCount       As Long

        Set wksData = Worksheets("Sheet1")
        lngTotalCount = wksData.Range("A1").CurrentRegion.Rows.Count
        lngCounter = 1

        With wksData
            While lngCounter <= lngTotalCount
                If (UCase(Trim(.Cells(lngCounter, 2))) = "A" Or UCase(Trim(.Cells(lngCounter, 2))) = "B") And UCase(Trim(.Cells(lngCounter, 3))) = "0" Then
                    .Cells(lngCounter, 1).EntireRow.Delete
                    lngCounter = lngCounter - 1
                    lngTotalCount = lngTotalCount - 1
                End If
                lngCounter = lngCounter + 1
            Wend
        End With

End Sub

答案 1 :(得分:0)

你可以尝试这个:

Sub ConditionalRowDelete()

Set colA = Range("C1", Cells(Rows.Count, "C").End(xlUp))
Set colB = Range("D1", Cells(Rows.Count, "D").End(xlUp))
MsgBox colA.Rows.Count
For i = 1 To colA.Rows.Count
If colB(i) = 0 Then
If colA(i) = "A" Then
'colB(i).Select
With colB(i) 'Selection
Application.Union(.EntireRow, .Offset(1, 0).EntireRow).Delete 'Select
End With
'Selection.EntireRow.Select
'MsgBox "found A"
End If
If colA(i) = "B" Then
'colB(i).Select
With colB(i) 'Selection
Application.Union(.EntireRow, .Offset(-1, 0).EntireRow).Delete 'Select
End With

'MsgBox "found B"
End If
End If
Next
End Sub