Excel VBA 質問スレッド No.44 (解決済)

Sheet2のリストからSheet1を検索したい

投稿者 : bun     投稿日時 : 2018/05/01(Tue) 17:28:47     OS : 未指定     EXCEL : 未指定
Sheet1に13列8000行位の文字列あありますこれに対してSheet2のA列のリストにあるもの検索して黄色に塗りつぶしたい。

下記のようにSheet2のA1の内容を検索することはできましたがA2以降を次々に検索する方法がわかりません、お手数ではございますが、ご教授お願いします。

Sub シートを検索()

Dim i As String

Dim foundCell As Range

Dim firstFoundCell As Range

Dim searchResult As Range


i = Worksheets("Sheet2").Range("A1").Value

Set foundCell = Cells.Find(What:=i)

Set firstFoundCell = foundCell

Set searchResult = foundCell


Do

Set foundCell = Cells.FindNext(foundCell)

If foundCell.Address = firstFoundCell.Address Then

Exit Do

Else

Set searchResult = Union(searchResult, foundCell)
End If
Loop

searchResult.Interior.Color = vbYellow




[返信 1] Re : Sheet2のリストからSheet1を検索したい
投稿者 : 管理人     投稿日時 : 2018/05/01(Tue) 23:16:54
投稿していただいた"シートを検索"サブルーチンを少し変更して、他のサブルーチンから呼び出せるように関数化しました。
そして、その関数を"サンプル"サブルーチンのSheet2ループ内から呼び出すことで、Sheet2のA2セル以降も検索できるようにしています。

Sub サンプル()

Dim s2 As Worksheet
Dim r2 As Integer
Dim target As String

Set s2 = Worksheets("Sheet2")
r2 = 1

' Sheet2のA列を順に検索
Do Until s2.Cells(r2, 1).Value = ""

' "シートを検索2" を呼び出す
Call シートを検索2(s2.Cells(r2, 1).Value)

r2 = r2 + 1

Loop

End Sub

Sub シートを検索2(target As String)

Dim foundCell As Range
Dim firstFoundCell As Range
Dim searchResult As Range

Set foundCell = Cells.Find(What:=target)

' 検索対象が見つからなかった場合は後述の色付け処理をスキップ
If foundCell Is Nothing Then Exit Sub

Set firstFoundCell = foundCell
Set searchResult = foundCell

Do

Set foundCell = Cells.FindNext(foundCell)

If foundCell.Address = firstFoundCell.Address Then
Exit Do
Else
Set searchResult = Union(searchResult, foundCell)
End If

Loop

searchResult.Interior.Color = vbYellow

End Sub

[返信 2] Re : Sheet2のリストからSheet1を検索したい
投稿者 : bun     投稿日時 : 2018/05/02(Wed) 09:28:42
ありがとうございました。
無事に完成いたしました。

スポンサード リンク
 
 
当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2019-07-18 01:54:12 )

Page
Top