プロが教える店舗&オフィスのセキュリティ対策術

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

質問者からの補足コメント

  • こんばんは。ご回答ありがとうございます。

    myStr = Application.InputBox("削除する文字列を入力")でインプットボックスを表示させるのではなく、
    テキストボックスTextShoyu1の値を参照してCommandButton1クリックでイベントを行いたいです。

    よろしくお願いいたします。

      補足日時:2016/12/20 19:57
  • こんばんは。
    myStr = Application.InputBox("削除する文字列を入力")を
    myStr = Me.TextShoyu1.Value

    としたら全然別のところで該当するデータはありませんというMsgBoxが出たのでお聞きしました。

    No.3の回答に寄せられた補足コメントです。 補足日時:2016/12/20 20:47
  • UserForm1上のTextNumber_Changeとそれに付随するSpinButton1_SpinDown()、SpinUpと
    ComboKokyakumei_Changeでデータベースを呼び出してたんですが、
    どれも「該当するデータがありません」というMsgBoxが表示されます。

    myStr = Me.TextShoyu1.Value

    Me.TextShoyu1.ValueはTextNumberによっては数値が入っていたり空欄だったりします。

    No.4の回答に寄せられた補足コメントです。 補足日時:2016/12/20 21:17
  • 詳しくはNo.4の方の補足に書きましたが
    UserForm上にデータを呼び出せなくなりました。
    CommandButton1_Clickする以前の処理が出来なくなりました。

    No.5の回答に寄せられた補足コメントです。 補足日時:2016/12/20 21:21
  • 何度かファイルを閉じてやり直してみました。
    すると、先程のMsgBoxは表示されなくなり、UserForm上に今まで通りにデータも呼び出せましたが、

    例えばTextShoyu1に30という値が入ってる時にCommandButton1をクリックしてみましたが、
    ”顧客名”のA列に30が入っている行は削除されず、MsgBoxに該当データなしが表示されました。

      補足日時:2016/12/20 21:36
  • その2行を削除しました。
    MsgBoxは当然表示されなくなりましたが、
    行削除は出来ませんでした。

    No.7の回答に寄せられた補足コメントです。 補足日時:2016/12/20 21:46
  • A列に入るTextNumberもTextShoyu1もIMEModeは2-fmIMEModeOffにして半角入力にしています。
    "顧客名"シートを確認しても半角数字のみで全角数字も文字列もありませんでした。

    上記のmyStr = StrConv(Me.TextShoyu1, vbNarrow)でも結果は変わらずでした。

    お手間をおかけして申し訳ありません。

    No.8の回答に寄せられた補足コメントです。 補足日時:2016/12/20 22:32
  • こんにちは。
    =MATCH(検索数値,顧客名!A:A,0)で試してみました。
    ちゃんと行番号が返ってきました。
    Private Sub NyuryokuButton1_Click()以下にNo.2で教えていただいたコードを書き、
    myStr = Me.TextShoyu1.Valueを
    myStr = StrConv(Me.TextShoyu1, vbNarrow)に変更。

    Else
    MsgBox "該当データなし"を削除し、

    End If
    End With以下に下記のように書いています。

    Worksheets("買増確認一覧表").Rows(Me.TextShoyu1.Value * 2 + 2).Hidden = True
    Worksheets("データベース").Rows(Me.TextShoyu1.Value).Hidden = True
    End Sub

    No.9の回答に寄せられた補足コメントです。 補足日時:2016/12/21 13:12
  • またもやお世話になり、ありがとうございます。
    ちょっと諦め気味に当初のコードに戻していたところでした。

    A列には同じ数値は1つしか入らないので
    添付画像のとおり、いただいたコードでサクサク行きました。

    ちなみにですが、当初のコードに
    MsgBox ("実行時間(秒)=" & Second(etime - stime))を表示させるにはどこの部分に挿入すれば計測出来ますか?
    ちなみに体感的には10秒以上はかかっています。
    厚かましいお願いですが、ご教授いただけたら幸いです。

    「【エクセル】TextBoxの数値の入った」の補足画像9
    No.10の回答に寄せられた補足コメントです。 補足日時:2016/12/23 02:39
  • おはようございます。
    時間計測の手順とても参考になりました。
    ありがとうございます。

    ちなみに昨日と同じデータで計測してみたら最初のコードは12秒でした。

    「【エクセル】TextBoxの数値の入った」の補足画像10
    No.11の回答に寄せられた補足コメントです。 補足日時:2016/12/23 10:10

A 回答 (11件中1~10件)

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


------------------------------------------------------
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
-------------------------------------------------
最後に実行時間を表示しています。不要であれば、この行をコメントアウトしてください。
こちらの環境では、20000行のうちA列が5のデータを3000件で
実行したところ6秒かかりました。
もっと、速い方法を望まれる場合は、このサンプルは試さないでください。
このスペックでもよいなら試してください。
実行時は、ブックのバックアップをとってから試してください。
この回答への補足あり
    • good
    • 1

以下のようになります。


--------------------------------------------------
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型を使用したほうが良いでしょう。)
この回答への補足あり
    • good
    • 0

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


どこかが「別物」というコトになります。

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

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

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

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

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


(もしくは逆のパターン)

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

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

※ A列が文字列・数値が混在の場合はちょっと厄介になりそうです。m(_ _)m
この回答への補足あり
    • good
    • 0

No.2・5です。



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

の2行を削除したらどうなりますか?m(_ _)m
この回答への補足あり
    • good
    • 0

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



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

あと、よろしく。
    • good
    • 0

No.2です。



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

テキストボックスの「オブジェクト名」が「TextShoyu1」となっているのであれば
前回のコードの
>myStr = Application.InputBox("削除する文字列を入力")

>myStr = Me.TextShoyu1.Value
に変更するだけで大丈夫だと思うのですが・・・

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

原因が判りませんが、この程度でごめんなさい。m(_ _)m
この回答への補足あり
    • good
    • 0

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


myStrには何が入ってます?
この回答への補足あり
    • good
    • 0

えっ!?


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

そこまで書けと?
出来ますよね?
この回答への補足あり
    • good
    • 0

こんばんは!



一例です。

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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!