Question

嘿伙计们我正在尝试编写一个代码来删除具有使用公式找到的值的行。问题是每隔一行都是#VALUE!，由于报告的设置，我无法更改。最后，我想要删除#VALUE!的所有行以及Column H中值小于.75的任何行。

我尝试过的代码如下所示：

Private Sub CommandButton1_Click()
    Dim rng As Range, cell As Range, del As Range
    Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
    For Each cell In rng
        If (cell.Value) < .75 Then
            If del Is Nothing Then
                Set del = cell
            Else: Set del = Union(del, cell)
            End If
        End If
    Next cell
    On Error Resume Next
    del.EntireRow.Delete
End Sub

任何帮助或提示都将不胜感激。

Answer 1

我建议您在行中向后退步，以便在删除行时不会丢失您的位置。

假设您想要查看H列中包含的单元格，您可以执行以下操作：

Sub Example()
    Const H As Integer = 8
    Dim row As Long

    For row = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        On Error Resume Next
        If Cells(row, H).Value < 0.75 Then
            Rows(row).Delete
        End If
        On Error GoTo 0
    Next
End Sub

Answer 2

我的代码是其他答案的替代品，它的效率更高，执行速度更快，然后分别删除每一行:)给它一个去吧

Option Explicit

Sub DeleteEmptyRows()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim i&, lr&, rowsToDelete$, lookFor$, lookFor2$

    '*!!!* set the condition for row deletion
    lookFor = "#VALUE!"
    lookFor2 = "0.75"

    Set ws = ThisWorkbook.Sheets("Sheet1")
    lr = ws.Range("H" & Rows.Count).End(xlUp).Row

    ReDim arr(0)

    For i = 1 To lr
     If StrComp(CStr(ws.Range("H" & i).Text), lookFor, vbTextCompare) = 0 Or _
        CDbl(ws.Range("H" & i).Value) < CDbl(lookFor2) Then
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr) - 1) = i
     End If
    Next i

    If UBound(arr) > 0 Then
        ReDim Preserve arr(UBound(arr) - 1)
        For i = LBound(arr) To UBound(arr)
            rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
        Next i

        ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
    Else
        Application.ScreenUpdating = True
        MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
        Exit Sub
    End If

    If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
    Set ws = Nothing
End Sub

Answer 3

尝试：

Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range, v As Variant
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
    v = cell.Text
    If v < 0.75 Or v = "#VALUE!" Then
        If del Is Nothing Then
            Set del = cell
        Else: Set del = Union(del, cell)
        End If
    End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

使用VBA删除excel中的行，具体取决于使用公式找到的值

3 个答案: