【エクセル】TextBoxの数値の入った行を削除する

Question

Worksheets("顧客名")のA列に1から順に数値が入っています。
例えばTextShoyu1の値が5の時はA列に5が入った行を削除するために以下のように書きました。
イベントとしては思い通りになったのですが、ループ処理に非常に時間がかかります。
どこを修正すればスムーズな処理が出来るでしょうか？
よろしくお願いいたします。

Private Sub CommandButton1_Click()

Dim i As Long

  For i = Range("A1").End(xlDown).Row To 2 Step -1
  With Worksheets("顧客名").Cells(i, "A")

    If _
    .Value Like Me.TextShoyu1.Value Then

      .EntireRow.Delete

    End If

  End With
  Next i
End Sub

tatsu99 · Accepted Answer

閉じてないようでしたので、参考になれば幸いです。
------------------------------------------------------
Private Sub CommandButton1_Click()
    Dim sh As Worksheet
    Dim ix As Long
    Dim stime As Variant
    Dim etime As Variant
    Application.ScreenUpdating = False
    stime = Time
    If TextShoyu1.Text = "" Then
        MsgBox ("削除条件設定")
        Exit Sub
    End If
    Set sh = Worksheets("顧客名")
    For ix = sh.Cells(sh.Rows.Count, 1).End(xlUp).row To 2 Step -1
        If TextShoyu1.Text = sh.Cells(ix, 1) Then
            sh.Rows(ix).Delete
        End If
    Next
    etime = Time
    Application.ScreenUpdating = True
    MsgBox ("実行時間(秒)=" & Second(etime - stime))
End Sub
-------------------------------------------------
最後に実行時間を表示しています。不要であれば、この行をコメントアウトしてください。
こちらの環境では、２００００行のうちA列が５のデータを３０００件で
実行したところ６秒かかりました。
もっと、速い方法を望まれる場合は、このサンプルは試さないでください。
このスペックでもよいなら試してください。
実行時は、ブックのバックアップをとってから試してください。

tatsu99 · Answer

以下のようになります。
--------------------------------------------------
Private Sub CommandButton1_Click()
Dim stime As Date    '開始時刻用
Dim etime As Date    '終了時刻用
Dim i As Long
stime = Time    '開始時刻取得

For i = Range("A1").End(xlDown).row To 2 Step -1
With Worksheets("顧客名").Cells(i, "A")

If _
.Value Like Me.TextShoyu1.Value Then

.EntireRow.Delete

End If

End With
Next i
etime = Time    '終了時刻取得
MsgBox ("実行時間(秒)=" & Second(etime - stime))
End Sub
-------------------------------------------------------
今後、時間を計測したい場合、一般的には、以下のような手順になります。
Dim stime As Date    '開始時刻用
Dim etime As Date    '終了時刻用

stime = Time    '開始時刻取得
・・・・計測したい処理
etime = Time    '終了時刻取得

MsgBox ("実行時間(秒)=" & Second(etime - stime))

---------------------------------
処理時間を計測したい直前に
stime=Timeをかくと、現在時刻をstimeに格納します。
計測したい処理が終わった後で、
etime = Timeをかくと現在時刻をetimeに格納します。
msgboxに表示するのは、そのあと、どこでも構いません。
（通常は、etime=Timeの直後でよいかと）
Second(etime-stime)の意味ですが、
Timeで取得した値（stime,etime）の単位は秒でなく、excel固有のDate型で示される単位です。
そのため、Second関数で秒に換算して、表示します。
（最初に投稿したときは、stime,etimeをVriantで定義しました。Variantでも問題なく動作しますが、
Date型のほうが時間を扱っていることが明確になるので、時間計測の場合はDate型を使用したほうが良いでしょう。）

tom04 · Answer

となると見た目には同じに見えても
どこかが「別物」というコトになります。

不要なスペースが入っていたり・・・

あくまで完全一致が前提のコードですので
試しにどこか使っていないセルにMATCH関数などを使って
=MATCH(検索数値,顧客名!A:A,0)
（検索数値とはテキストボックスに入力する数値）
としてみてください。
ちゃんと数値(行番号）が表示されればそのデータは存在する！というコトになり、
#N/A　と表示されれば存在しない！というコトになります。

万一エラーが表示される場合は見た目は同じでも別物です。

※　こちらではお手元のデータがどのようになっているのか判断できませんので
いままでのやり取りで考えられるといえばこの程度ですかね。m(_ _)m

tom04 · Answer

A列が半角でテキストボックスが全角というコトはないですか？
（もしくは逆のパターン）

同じ数値でも全角と半角では別物になります。
A列データが数値の半角という前提であれば

myStr = StrConv(Me.TextShoyu1, vbNarrow)
のようにしてみてください。

※　A列が文字列・数値が混在の場合はちょっと厄介になりそうです。m(_ _)m

tom04 · Answer

No.2・5です。

メッセーボックスが邪魔をしている可能性がありますので、
コード内の
＞Else
＞MsgBox "該当データなし"

の2行を削除したらどうなりますか？m(_ _)m

くんこば · Answer

ソースコード全部とフォームの画像載せて。

と、思ったけど、時間も無いんで撤退しますわー。

あと、よろしく。

tom04 · Answer

No.2です。

ん～～～
ユーザーフォームにテキストボックスとコマンドボタンを配置しているのですよね？

テキストボックスの「オブジェクト名」が「TextShoyu1」となっているのであれば
前回のコードの
＞myStr = Application.InputBox("削除する文字列を入力")
を
＞myStr = Me.TextShoyu1.Value
に変更するだけで大丈夫だと思うのですが・・・

＞全然別のところで・・・
とはどこでメッセーボックスが出たのでしょうか？
イマイチ理解できないのでですが、
結論としてそういうメッセージが出たというコトは
「顧客名」シートのA列に「TextShoyu1」に入力したデータがない！
というコトになると思われます。

原因が判りませんが、この程度でごめんなさい。m(_ _)m

くんこば · Answer

ステップ実行は出来ますか？
myStrには何が入ってます？

くんこば · Answer

えっ！？
２さんがコード載せてるでしょ？
inputboxの所を書き換えたらいいだけでしょ？

そこまで書けと？
出来ますよね？

tom04 · Answer

こんばんは！

一例です。

Private Sub CommandButton1_Click()
    Dim myStr As String, myRng As Range
    Dim myFound As Range, myFirst As Range
        myStr = Application.InputBox("削除する文字列を入力")
            With Worksheets("顧客名")
                Set myFound = .Range("A:A").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
                    If Not myFound Is Nothing Then
                        Set myRng = myFound
                        Set myFirst = myFound
                        Do
                            Set myFound = .Range("A:A").FindNext(after:=myFound)
                            If myFound.Address = myFirst.Address Then Exit Do
                            Set myRng = Union(myRng, myFound)
                        Loop
                        myRng.EntireRow.Delete
                    Else
                        MsgBox "該当データなし"
                    End If
            End With
End Sub

※　No.1さんと同意見でFindメソッドにしています。m(_ _)m

【エクセル】TextBoxの数値の入った行を削除する

閉じてないようでしたので、参考になれば幸いです。

以下のようになります。

となると見た目には同じに見えても

A列が半角でテキストボックスが全角というコトはないですか？

No.2・5です。

ソースコード全部とフォームの画像載せて。

No.2です。

ステップ実行は出来ますか？

えっ！？

こんばんは！

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング