[[20220121081819]]　『行削除について』（hirotaka）　ページの最後に飛ぶ

『行削除について』（hirotaka）

下記のように、コピペのマクロはできています、この後「成績大中小の小中のみ」のシートの行削除を一気に処理したいと思いネットや皆さんの協力をもらって作成しました。しかし、処理すると固まってしまい、Excelが動かなくなります。どこがおかしいのか教えて頂けませんか。

Sub コピペする()
'Sheet1のA3から最終行までをコピー
With Sheets("成績順")
.Range("A3:J" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy
End With
'Sheet2のA列の最終行の次の行に貼付け
Sheets("成績大中小の小中のみ").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
Application.CutCopyMode = False
End Sub

Sub 条件に一致した行を削除する()
Dim i As Long
With Worksheets("成績大中小の小中のみ")
For i = .Range("A1").End(xlDown).Row To 2 Step -1
With .Cells(i, "J")
If _
.Value Like "大*" Then
.EntireRow.Delete
End If
End With
Next i
End With
End Sub

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

＞.EntireRow.Delete
の後に
DoEvents
を追記して試してください。
（tkit） 2022/01/21(金) 09:48

＞.EntireRow.Delete
＞の後に
＞DoEvents
＞を追記して試してください。

１０分しても処理がおわりません。すみません、やり方がおかしいのでしょうか。
お教えくださいませんでしょうか。

＞１０分しても処理がおわりません。

どの程度のデータがあって、どの程度削除するのでしょうか？
（tkit） 2022/01/21(金) 10:40

移動再計算を止める。
（直感） 2022/01/21(金) 10:44

＞１０分しても処理がおわりません。
＞どの程度のデータがあって、どの程度削除するのでしょうか？

１３００件ほどです。

＞移動再計算を止める。

すみません、これはどういうことですか、どのように修正したらとめられますか。
（hirotaka） 2022/01/21(金) 11:03

あ、ごめん
自動再計算
（直感） 2022/01/21(金) 11:08

それと、DoEvents は、遅くなる原因でもある。
ほどほどに。
（直感） 2022/01/21(金) 11:18

新しいものをみつけました。しかし、これで処理したら４分２８秒かかりました。これは短いのか長いのかわかりませんが、もう少し早くなったらいいのですが、諦めてオートフィルで抽出して削除した方がはやいかもしれませんね。
もし、早くなるコードがあればお教え頂けますか。よろしくお願い致します。

Sub 指定文字行削除()

Dim LastRow As Long
Dim i As Long

    With Worksheets("成績 大中小の小中のみ")

    '最終行取得
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    With ActiveSheet

        '最終行から先頭へループ
        For i = LastRow To 1 Step -1

            '特定文字があったら行削除
            If InStr(Cells(i, 10), "大") >= 1 Then
                .Rows(i).Delete
            End If
        Next
    End With
    End With

End Sub

（hirotaka） 2022/01/21(金) 12:48

 一括削除です。

 Sub sample()
     Dim searchRange As Range
     With Worksheets("成績 大中小の小中のみ")
         Set searchRange = Range("J2").Resize(.Range("A1").End(xlDown).Row - 1, 1)
     End With

     Dim deleteArea As Range
     Dim r As Range
     For Each r In searchRange
         If r.Value Like "大*" Then
             If deleteArea Is Nothing Then
                 Set deleteArea = r
             Else
                 Set deleteArea = Union(deleteArea, r)
             End If
         End If
     Next

     For Each r In deleteArea.Areas
         r.EntireRow.Delete
     Next
 End Sub

（tkit） 2022/01/21(金) 12:55

ご参考。

https://www.google.com/search?q=VBA+%E9%AB%98%E9%80%9F%E5%8C%96

（ひまつぶし） 2022/01/21(金) 12:59

内容が被りましたが投稿しておきます。

■１
＞処理すると固まってしまい～
とりあえず【ステップ実行】して何行目の処理をしているときに問題が生じているのか検証してみてはどうでしょうか？

■２
こだわりがなければ【インデント】を設定されたほうがよいとおもいます。
マクロの実行に影響がでるものではありませんが、適切なインデントを設定することでコードの構造が把握しやすくなり、ご自身のデバッグ作業の効率アップに寄与すると思います。

■３
削除のほうについて、１行ずつ判定と削除を繰り返しているわけですが、対象のセル（行）をおぼえておいて、覚えておいたセル（行）を一括削除という手もあろうかとおもいます。

■４
上記を踏まえると、例えば↓のような感じでも良いようにおもいます。

    Sub コピペする_改()
        With Sheets("成績順")
            .Range("A3:J" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy _
            Sheets("成績 大中小の小中のみ").Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End Sub
    '---------------------------------------------------
    Sub 条件に一致した行を削除する_改()
        Dim i As Long, bufRNG As Range

        Stop 'ブレークポイントの代わり

        With Worksheets("成績 大中小の小中のみ")
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If .Cells(i, "J").Value Like "大*" Then
                    If bufRNG Is Nothing Then
                        Set bufRNG = .Cells(i, "J")
                    Else
                        Set bufRNG = Union(bufRNG, .Cells(i, "J"))
                    End If
                End If
            Next i
        End With

        If Not bufRNG Is Nothing Then
            bufRNG.EntireRow.Delete
        End If
    End Sub

（もこな２） 2022/01/21(金) 13:02

（tkit）さんできました。１３秒でできました。（もこな２）さんありがとうございます。【インデント】を設定をやるようにします。大変助かります、何件かこれと同じようなデーターがあります。お世話になりました。色々な方にお世話になりました。感謝しています。ありがとうございました。
（hirotaka） 2022/01/21(金) 13:16

コメント返信：

[ 一覧(最新更新順) ]

[[20220121081819]] 『行削除について』（hirotaka） ページの最後に飛ぶ

[[20220121081819]]　『行削除について』（hirotaka）　ページの最後に飛ぶ