2

誰か助けてください。Excelワークシートの列「D」で特定の単語「DR」を検索し、行全体を削除するVBAコードを作成しようとしています。ワークシートには、特定の単語が多数出現しています。私がやりたいことは、これらの出現箇所を検索して、それらの単語を含む行全体を削除することだけです。私の問題は、どのループ構造を使用すればよいかわからないことです。以下は私が使用しているコードです。 

    列("D:D").選択
    Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart、SearchOrder:=xlByRows、SearchDirection:=xlNext、MatchCase:=False _
        、SearchFormat:=False).Activate

    行う
    Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart、SearchOrder:=xlByRows、SearchDirection:=xlNext、MatchCase:=False _
        、SearchFormat:=False).Activate


   ActiveCell.EntireRow.Delete

Loop While (Cells.Find(What:="DR"))

喜んでお手伝いさせていただきます。

4

3 に答える 3

2

クリーンでシンプル、トリックを行います! ;)

LastRow = Cells(Rows.Count, "D").End(xlUp).Row

For i = LastRow To 1 Step -1
   If Range("D" & i).Value = "DR" Then
      Range("D" & i).EntireRow.Delete
   End If
Next i
于 2013-10-10T07:19:54.503 に答える
1

また、Find を使用した別の方法...

Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
        sFirstAddress = rFind.Address
        Do
            If rDelete Is Nothing Then
                Set rDelete = rFind
            Else
                Set rDelete = Application.Union(rDelete, rFind)
            End If
            Set rFind = .FindNext(rFind)
        Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

        rDelete.EntireRow.Delete

    End If
End With
Application.ScreenUpdating = True
End Sub

以下の例は似ていますが、一番下から始まり、逆の順序で一番上に向かっています。一度にすべてではなく、一度に各行を削除します。

Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not rFind Is Nothing Then
        Do
            Set rDelete = rFind
            Set rFind = .FindPrevious(rFind)
            If rFind.Address = rDelete.Address Then Set rFind = Nothing
            rDelete.EntireRow.Delete
        Loop While Not rFind Is Nothing
    End If
End With
Application.ScreenUpdating = True
End Sub
于 2013-10-10T08:13:15.473 に答える