0

データがない場合、行を削除しようとしていますA:J

このコードを見つけて編集しようとしましたが、最終的にシート全体のデータが削除されます。

どんな助けでも大歓迎です

 Sub DeleteRows()
    Dim rngBlanks As Range
    Dim i As Integer

    For i = 1 To 10
        On Error Resume Next
        Set rngBlanks = Columns(i).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        If Not rngBlanks Is Nothing Then
            rngBlanks.EntireRow.Delete
        End If
    Next
 End Sub
4

2 に答える 2

1

行 A:J にデータがない場合、行を削除しようとしています

コードが行っているのはA:J、タイトルが示唆する範囲ではなく、列を個別にチェックすることです。これにより、データ全体が削除される可能性が非常に高くなります。A1いくつかのデータがありますが、B1ありません。したがって、コードは削除されRow 1ます。あなたがしなければならないことは、 sayA1:J1が空白かどうかを確認することです。

これがあなたがしようとしていることだと思いますか？

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim rngBlanks As Range
    Dim i As Long, lRow As Long, Ret As Long

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet2")

    With ws
        '~~> Get the last row in that sheet
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If

        '~~> Loop through the rows to find which range is blank
        For i = 1 To lRow
            Ret = Application.Evaluate("=COUNTA(A" & i & ":J" & i & ")")
            If Ret = 0 Then
                If rngBlanks Is Nothing Then
                    Set rngBlanks = .Rows(i)
                Else
                    Set rngBlanks = Union(rngBlanks, .Rows(i))
                End If
            End If
        Next i
    End With

    '~~~> Delete the range
    If Not rngBlanks Is Nothing Then rngBlanks.Delete
End Sub

別の方法は、オートフィルターを使用してそれらの範囲を削除することです

于 2013-10-05T09:25:00.843 に答える
-1

列 A:J から行 15 までの空白でないセルを含むシートを使用して、コードをステップ実行しました。行 16:18 は完全に空白で、D19=1 でした。A:J からすべてのセルに空白がある行を削除します。

For..Next ループの最初の繰り返しで、rngBlanks は Nothing ではありませんでした。

?rngBlanks.address

$A$1,$A$5:$A$19 を返しました。A2:A4 は空白ではありませんでした。実行すると

Set rngBlanks = Columns(i).SpecialCells(xlCellTypeBlanks)

テストしたくない列Aの空白を探します。おそらく ActiveSheet.UsedRange 内の各行をテストして、列 A:J がすべて空白かどうかを確認します。したがって、変数を定義する必要があります

Dim Rw as Range

UsedRange の各 Rw を反復処理します。

For Each Rw in ActiveSheet.UsedRange

If WorksheetFunction.CountBlank(range(cells(Rw,1),cells(Rw,10))) =0 Then

    Rw.EntireRow.Delete

ここにコード全体を投稿することもできますが、私が提供したものはあなたを正しい軌道に乗せるはずです。

于 2013-10-05T09:25:09.770 に答える