Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8419 / 13646 ツリー ←次へ | 前へ→

【33427】文字列を含む行全てを選択するマクロ GED 06/1/11(水) 22:03 質問[未読]
【33428】Re:文字列を含む行全てを選択するマクロ かみちゃん 06/1/11(水) 22:20 回答[未読]
【33429】Re:文字列を含む行全てを選択するマクロ GED 06/1/11(水) 22:28 お礼[未読]

【33427】文字列を含む行全てを選択するマクロ
質問  GED  - 06/1/11(水) 22:03 -

引用なし
パスワード
   質問させてください
知り合いに頼んで、ある文字列を含む行を全て選択するマクロを作ってもらいました
下に記したものがそのマクロです
実際に実行してみると、単純なサンプルではうまく動きました
A  B
xxx
a  xxx
b ←この行以外が選択される
xxx

しかし、同じ行に同じ文字列が2つ以上ある場合、うまく動かずマクロがとまってしまいました
A  B
xxx xxx ←この行のみ選択され、マクロがとまる
a  xxx
b 
xxx

私はVBAに関して素人なので、どこを直せば良いのかさっぱりわかりません
知り合いに聞けばよいのですが、しばらく仕事が忙しいようで連絡がとれていません
解決法を教えていただけないでしょうか?

Option Explicit

Sub E_trade()
   Dim sFirstAddress As String
   Dim rFindCell   As Range
   Dim rMultiRange  As Range

   With ActiveSheet
     Set rFindCell = .Cells.Find(What:="xxx")
     Set rMultiRange = Nothing

     If Not rFindCell Is Nothing Then
       sFirstAddress = rFindCell.Address
       Do
         If rMultiRange Is Nothing Then
           Set rMultiRange = rFindCell.EntireRow
         Else
           Set rMultiRange = Application.Union(rMultiRange, rFindCell.EntireRow)
         End If

         Set rFindCell = .Cells.FindNext(rFindCell)
       Loop While Not rFindCell Is Nothing And rFindCell.Address < sFirstAddress
     End If
     If Not rMultiRange Is Nothing Then rMultiRange.Select
   End With
End Sub

【33428】Re:文字列を含む行全てを選択するマクロ
回答  かみちゃん E-MAIL  - 06/1/11(水) 22:20 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>しかし、同じ行に同じ文字列が2つ以上ある場合、うまく動かずマクロがとまってしまいました

マクロがとまるというより、正常に処理が終わっています。
しかし、期待している結果が得られないということですよね?

ちょっと検証してみたところ、
Loop While Not rFindCell Is Nothing And rFindCell.Address < sFirstAddress
の部分を
Loop While Not rFindCell Is Nothing And rFindCell.Address <> sFirstAddress
としてください。
「<」を「<>」とすればいいと思います。

なお、Findメソッドのヘルプをご確認いただけると、これとよく似た使用例が載っています。

他に、IV列などの作業列を使っていいならば、その列に 1 などの数値を入れてい
って、IV列に数値が入っている行だけを選択するという方法もあります。

【33429】Re:文字列を含む行全てを選択するマクロ
お礼  GED  - 06/1/11(水) 22:28 -

引用なし
パスワード
   動作確認できました
本当に助かりました

かみちゃんさん、ありがとうございました

8419 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free