2

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

我尝试的代码如下所示：

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

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

4

3 回答 3

4

我建议在行中倒退，这样当一行被删除时，你就不会失去你的位置。

假设您想查看 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
于 2013-06-11T13:31:36.660 回答
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
于 2013-06-11T13:46:24.200 回答
0

尝试：

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
于 2013-06-11T13:38:07.817 回答