1

オンラインで見つけたコードを編集したいと考えています。コードは VBA にあり、マクロ コードで 1 つではなく複数の行を削除する必要があります。コードは次のとおりです。

Sub findDelete()
    Dim c As String
    Dim Rng As Range

    c = InputBox("FIND WHAT?")

    Set Rng = Nothing

    Set Rng = Range("A:A").Find(what:=c, _
        After:=Range("A1"), _
        LookIn:=xlFormulas, _
        lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)

    Rng.EntireRow.Delete shift:=xlUp
End Sub
4

3 に答える 3

4

検索を使用する代わりにAutofilter、VisibleCells

Sub findDelete()

Dim c As String, Rng As Range, wks as Worksheet

c = InputBox("FIND WHAT?")

Set wks = Sheets(1) '-> change to suit your needs
Set Rng = wks.Range("A:A").Find(c, After:=Range("A1"), LookIn:=xlFormulas, _
                            lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False)

If Not Rng Is Nothing Then

    With wks

        .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).AutoFilter 1, c
        Set Rng = Intersect(.UsedRange, .UsedRange.Offset(1), .Range("A:A")).SpecialCells(xlCellTypeVisible)
        Rng.Offset(1).EntireRow.Delete

    End With

End If

End Sub

編集

入力ボックスを検索/削除する複数の値に置き換えるには、次の操作を行います。

Option Explicit

Sub FindAndDeleteValues()

Dim strValues() as String

strValues() = Split("these,are,my,values",",")

Dim i as Integer

For i = LBound(strValues()) to UBound(strValues())

    Dim c As String, Rng As Range, wks as Worksheet
    c = strValues(i)

    '.... then continue with code as above ...

Next

End Sub
于 2012-10-23T14:40:32.360 に答える
1

Whileループに巻き付けるだけです。

Sub findDelete()
    Dim c As String
    Dim Rng As Range
    c = InputBox("FIND WHAT?")
    Set Rng = Nothing
    Do While Not Range("A:A").Find(what:=c) Is Nothing
        Set Rng = Range("A:A").Find(what:=c, _
        After:=Range("A1"), _
        LookIn:=xlFormulas, _
        lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
        Rng.EntireRow.Delete shift:=xlUp
    Loop
End Sub
于 2012-10-23T14:36:19.470 に答える
0

の行を削除するコードは既にありRng.EntireRow.Delete shift:=xlUpます。必要なのは、範囲を削除する行に設定するコードです。VBA ではよくあることですが、これはさまざまな方法で実行できます。

'***** By using the Rng object
Set Rng = Rows("3:5")

Rng.EntireRow.Delete shift:=xlUp

Set Rng = Nothing

'***** Directly
Rows("3:5").EntireRow.Delete shift:=xlUp

あなたのFindステートメントは の最初の出現のみを見つけますc。そのため、複数の行を削除していません。

于 2012-10-23T14:41:14.917 に答える