根据每行多个单元格中的值删除行

时间:2018-10-23 19:38:19

标签: excel vba

下面的功能代码在该站点的答案中拼凑而成。

我觉得它没有它应该的优雅。

该代码的目的是检查每行五个单元格的范围,如果这些单元格中没有正值,则删除该行。

Sub DeleteRowtest()
Dim lr As Integer ' are any of these dims redundant or unnecessary? Incorrect?
Dim cval As Variant
Dim ArrCt As Integer
Dim val As Variant

'the initial redim is there on purpose
' instead of ValArray as Variant then ValArray = array().
' this seems cleaner but which is better?
ReDim ValArray(0) As Integer 

Dim T As Boolean

lr = Cells(Rows.Count, 11).End(xlUp).Row
For i = lr To 2 Step -1
    ArrCt = 0

    'this loop appears to work the way I want,
    ' but am I using .cells and .value correct here?
    For Each cval In Range(Cells(i, 5), Cells(i, 10)).Cells
        ValArray(ArrCt) = cval.Value
        ArrCt = ArrCt + 1
        ReDim Preserve ValArray(ArrCt)
    Next

    'is there a cleaner way than this array and nested loop
    ' to determine the same info and act on it?
    ' (i.e. if all values of cell range are <1 delete row)
    For Each val In ValArray
        If val > 0 Then
            T = True
        End If
    Next

    If T = False Then Rows(i & ":" & i).EntireRow.Delete
    T = False
Next

'finally, are there any errors/broken logic at all here that I dont see?

Range("B2").Select
End Sub

1 个答案:

答案 0 :(得分:0)

在将数据复制到数组并在检查值之后循环数组时,我看不出任何优势。
另外,我会谨慎使用integer类型,因为它只有-32 768到32767。我认为Long使用起来更安全。
当您引用单元格/范围时,请使用工作簿/工作表直接指向您想要的位置。
例如Cells(Rows.Count, 11).End(xlUp).Row指的是当前活动的工作表,这可能不是故意的。

这是我的版本

Option Explicit

Sub DeleteRowtest()
    Dim LastRow As Long, i As Long
    Dim Found As Boolean
    Dim Ws As Worksheet
    Dim aCell As Range

    'turn off screen updating and sheet calculation to improve speed
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set Ws = ThisWorkbook.Sheets("Your sheet name") 'set reference to sheet

    With Ws 'all references starting with "." from now on will refer to sheet "Ws"
        LastRow = .Cells(.Rows.Count, 11).End(xlUp).Row 'Find last row

        For i = LastRow To 2 Step -1 'loop rows from last to 2
            Found = False 'reset variable
            For Each aCell In .Range(.Cells(i, 5), .Cells(i, 10))
                If aCell.Value > 0 Then ' this will be true also for text in cells
                'if you want to check for numeric values only you can try this
            '   If aCell.Value > 0 And IsNumeric(aCell.Value) Then
                    Found = True
                    Exit For
                End If
            Next aCell
            If Not Found Then 'no positive value found in row
                .Rows(i & ":" & i).EntireRow.Delete
            End If
        Next i
        .Range("B2").Select
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub