Excel VBA 指定した文字の行だけを検索

質問

調べても分からなかったので質問させてください(ーー;)

Findメソッドを使ってシート全体や、A1:A10などは出来るのですが、
下記の表で「位置の行」のみを検索したいのですが、
どのようなコードがありますか？
「位置」の行で検索したい値は１つですが、
Ａ１、Ａ４のように「位置」が複数あります。
「位置」以外の行で重複する検索したい値がある可能性があるため、上記のようにしたいのです。
宜しくお願いします<(_　_)>

　Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　Ｈ　　　
１位置　文字　文字　文字　文字　文字　文字　文字
２文字　文字　文字　文字　文字　文字　文字　文字
３文字　文字　文字　文字　文字　文字　文字　文字
４位置　文字　文字 文字　文字　文字　文字　文字
５文字　文字　文字　文字　文字　文字　文字　文字

また、指定したセル背景色のみ選択してデータを抽出するようなコードがもしあれば
教えていただければ幸いです(_ _)
これは関数でもなんでも大丈夫です。

回答No.7

kagakusuki · ベストアンサー

回答No.3、4、6です。

>結論から言いますと、やりたいことに付随するコードは何でも良いです。

　了解しました。
　それでは、Findメソッドを使わない方向で考える事に致します。

>今現状必要な流れは稚拙な箇条書きながら下記の通りです。

>(1)シート全体を対象に指定した文字行で指定した文字を検索。
>（指定した文字行でというところが分かりませんでした。）
>（ここはFINDメソッドを使っていたので、FINDメソッドでも出来るのであれば、できないのであれば他でもというニュアンスでした）

>(2)検索した文字ワードがあれば色を塗る。
>(3)検索ワードがあれば、そこを基準に他のセルに違う色を塗る。
>(4)対象のシート全てに対して上記のコードを適応する。
>(5)別シートに色ごとの数値を順番に抽出していく。

　(3)の「そこを基準に」とは、「『検索ワードが含まれているデータが入っているセル』の位置を基準にする」という意味なのでしょうか？ それとも「『該当するセルに入っているデータ』を基準にして、その値の中から"抽出した別の文字列"を含んでいる値が入っているセルを検索する」という意味なのでしょうか？
　また、「他のセル」とは、どの様な基準で決まるセルの事なのでしょうか？
　その点が不明なため、とりあえず(3)に関しては無視し、(1)、(2)、(4)、(5)の処理を、同時に複数のシート(Sheet1,Sheet2,Sheet4)に対して行うVBAをお伝えしておきます。
　尚、

>(5)別シートに色ごとの数値を順番に抽出していく。

というだけの説明では、何というシートのどのセルから転記を開始して、どの方向に向かってどの様な順番で転記して行けば良いのか全く不明ですので、取り敢えず「転記」というシートのA列に該当セルが見つかったシート名を、B列に該当するセルのセル番号を、C列に該当するセルに入っている値を、2行目から下に向かって記入して行くものとしました。

Sub QNo9244934_Excel_VBA_指定した文字の行だけを検索5()

Const RowMark = "位置" '処理対象となる行の目印となる値
Const MarkColumn = "A" '処理対象となる行の目印となる値が入力されている列の列番号
Const CopySheetName = "転記" '転記先のシートのシート名
Dim strSearch As Variant, CopySheet As Worksheet, mySheetName As Variant _
, myColor As Long, i As Long, c As Range, myRange As Range, tempRange As Range

mySheetName = Array("Sheet1", "Sheet2", "Sheet4") '処理対象のシートのシート名
strSearch = "文字列" '検索する文字列
myColor = RGB(255, 255, 0) '検索する文字列を含む文字列が入力されているセルを塗りつぶす色

If IsError(Evaluate("ROW('" & CopySheetName & "'!A1)")) Then
MsgBox "転記先のシートとして設定されている" _
& vbCrLf & vbCrLf & CopySheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "転記先シート無し"
Exit Sub
End If
Set CopySheet = Sheets(CopySheetName)

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For i = 0 To UBound(mySheetName)
If Not IsError(Evaluate("ROW('" & mySheetName(i) & "'!A1)")) Then
With Sheets(mySheetName(i))
On Error Resume Next
Set myRange = Nothing
Set myRange = .Cells.SpecialCells(xlCellTypeConstants, xlTextValues + xlNumbers)
Set tempRange = Nothing
Set tempRange = .Cells.SpecialCells(xlCellTypeFormulas, xlTextValues + xlNumbers)
If Not tempRange Is Nothing Then
If myRange Is Nothing Then
Set myRange = tempRange
Else
Set myRange = Union(myRange, tempRange)
End If
On Error GoTo 0
End If

Set tempRange = Nothing
For Each c In .Range(MarkColumn & "1:" & MarkColumn & .Range(MarkColumn & Rows.Count).End(xlUp).Row)
If c.Value Like "*" & RowMark & "*" Then
If tempRange Is Nothing Then
Set tempRange = c.EntireRow
Else
Set tempRange = Union(tempRange, c.EntireRow)
End If
End If
Next c

If Not myRange Is Nothing Then Set myRange = Intersect(myRange, tempRange)
If Not myRange Is Nothing Then
For Each c In myRange
If c.Value = strSearch Then

'検索する文字列を含む文字列が入力されているセルが見つかった場合に行う処理(始)
c.Interior.Color = myColor '該当セルを塗りつぶす
CopySheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = mySheetName(i) '転記先シートのA列に該当セルが存在するシートのシート名を記入
CopySheet.Range("B" & Rows.Count).End(xlUp).Offset(1).Value = c.Address(False, False) '転記先シートBの列に該当セルのセル番号を記入
CopySheet.Range("C" & Rows.Count).End(xlUp).Offset(1).Value = c.Value '転記先シートのC列に該当セルに入っている値を転記
'検索する文字列を含む文字列が入力されているセルが見つかった場合に行う処理(終)

End If
Next c
End If
End With
End If
Next i

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

何から何までありがとうございます┏○))

ここまで丁寧に最初から最後まで構成したコードを作成していただけるとは思わず、躓いた部分に関してのみご教示いただき、後は自分でなんとかしていこうと思っていただけに、多々説明不足な所がありすみません。

まだまだＶＢＡに関して勉強不足ですが、今回皆さん方に教えていただいたコードを元に精進していきたいと思います。

またもし何かあればそのときは宜しくお願いいたします。

回答No.8

Prome_Lin

回答No.2です。

「位置」という文字があるのに、ひっかからないのは、前後にスペースなどが入っている場合が考えられます。

If Cells(i, 1).Value = "位置" Then

の部分を、「If Trim(Cells(i, 1).Value) = "位置" Then」（前後の無用なスペースを削除）とするか、「If InStr(Cells(i, 1).Value, "位置") > 0 Then」として、そのセルに「位置」という文字が含まれていれば、にすれば解決すると思います。

どちらにしても、「位　置」のように、「位置」という文字の間にスペースなどがあれば、ダメですが・・・

回答No.6

kagakusuki

回答No.3、4です。
　確認したいのですが、当方は質問文に

>Findメソッドを使って

という条件が記されていたため、Findメソッドを使った方法を回答したのですが、回答No.5様の様にFindメソッドを使わない方法でも宜しいのでしょうか？
　それならそれで別のやり方も考えられますので、上記の件に関して御補足頂く様御願い致します。

　後それからもう1点確認したい事があります。

>指定したセル背景色のみ選択してデータを抽出するようなコードがもしあれば
教えていただければ幸いです(_ _)

との要望ですが、これは

>Findメソッドを使って
>下記の表で「位置の行」のみを検索したい

という御質問内容とはまた別の話で、
「シート内に存在する特定の色で塗りつぶされているセルであれば、そのセルに入力されている文字列が何であるのかという事にはかかわらず、またそのセルが『位置の行』にあるのか否かという事にも関係なく、兎に角その色で塗りつぶされてさえいれば全て抽出したい」
という事なのでしょうか？
　それとも、

>Findメソッドを使って
>下記の表で「位置の行」のみを検索したい

という条件に

>指定したセル背景色のみ選択して

という条件に付け加えて
「下記の表の『位置の行』にあるセルの中から、特定の文字列のみが入力されていて、尚且つ特定の色で塗りつぶされているセルのみを検索したい」
という御要望なのでしょうか？

>もう一つだけ質問なのですが、位置列で同じ検索ワードが２以上あった場合にも対応していますが、1回目のhit 2回目のhit を判別する方法はどこを見ればいいですか？

　回答No.3で尋ねている事なのですが、

>Findメソッドを使って検索してヒットしたセルをどうしたいのでしょうか？

　その目的によっても回答は変わってきます。
　回答No.3、4ではその点が不明だったため、とりあえず仮の話として、

>該当するセルのみを全て選択した状態にしたい
>該当するセルが何個あるのかを調べたい

という御要望であると仮定した場合のVBAをお伝えしただけの事です。
　ですから、まず、

>Findメソッドを使って検索してヒットしたセルをどうしたいのでしょうか？

という当方が尋ねた補足要求に対して御返答願います。
　その内容次第で回答は変わってまいります。
　例えば、
「もし該当するセルが複数あった場合には、その該当セルを左上にあるものから順番に選択するとともにMsgBoxでそのセルのセル番号を表示して行きたい」
という事である場合には、回答No.3、4における
「変数Targetに検索で見つかった該当セルを付け加えて格納して行く」
という処理の代わりに、
「該当セルが1つ見つかるごとに、そのセルを選択するとともにMsgBoxでそのセルのセル番号を表示して行く」
という処理を行えば良いという事になります。

Sub QNo9244934_Excel_VBA_指定した文字の行だけを検索3()

Dim FoundCell As Range, FirstCell As Range, Target As Range

Set FoundCell = Cells.Find(What:="文字列")
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
GoSub Label_Found
Do
Set FoundCell = Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
GoSub Label_Found
End If
Loop
End If
If FirstCell Is Nothing Then
MsgBox "該当するセルは見つかりませんでした"
Else
MsgBox "該当するセルは以上です"
End If
Exit Sub

Label_Found:
If Range("A" & FoundCell.row).Value = "位置" Then
FoundCell.Activate
MsgBox "該当するセルは" & vbCrLf _
& FoundCell.Address(False, False) & "セルです"
End If
Return

End Sub

或は

Sub QNo9244934_Excel_VBA_指定した文字の行だけを検索4()

Dim FoundCell As Range, FirstCell As Range _
, c As Range, SearchRow As Range

For Each c In Range("A1:A" _
& Range("A" & Rows.Count).End(xlUp).row)
If c.Value = "位置" Then
If SearchRow Is Nothing Then
Set SearchRow = c.EntireRow
Else
Set SearchRow = Union(SearchRow, c.EntireRow)
End If
End If
Next c

If Not SearchRow Is Nothing Then
Set FoundCell = SearchRow.Find(What:="文字列")
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
GoSub Label_Found
Do
Set FoundCell = SearchRow.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
GoSub Label_Found
End If
Loop
End If
End If
If FirstCell Is Nothing Then
MsgBox "該当するセルは見つかりませんでした"
Else
MsgBox "該当するセルは以上です"
End If
Exit Sub

Label_Found:
FoundCell.Activate
MsgBox "該当するセルは" & vbCrLf _
& FoundCell.Address(False, False) & "セルです"
Return

End Sub

補足

何度も回答していただいてありがとうございます(_ _)

結論から言いますと、やりたいことに付随するコードは何でも良いです。
ただ、複雑なコードだと自分で応用できないかもしれないと思ったので、
あくまでやりたいことの一部分を質問させていただきました。

今現状必要な流れは稚拙な箇条書きながら下記の通りです。

(1)シート全体を対象に指定した文字行で指定した文字を検索。
（指定した文字行でというところが分かりませんでした。）
（ここはFINDメソッドを使っていたので、FINDメソッドでも出来るのであれば、できないのであれば他でもというニュアンスでした）

(2)検索した文字ワードがあれば色を塗る。
(3)検索ワードがあれば、そこを基準に他のセルに違う色を塗る。
(4)対象のシート全てに対して上記のコードを適応する。
(5)別シートに色ごとの数値を順番に抽出していく。

(2)、(3)、(4)、(5)、に関しては出来ました。

hitしたワードの位置を保持したままにできるのなら、
今後のために活用できると思い、この際に聞いておこうと思い追加で質問しました。
1hit目にはaを、2hit目にはbをという事が出来ると思ったので(ーー;)

回答No.5

ushi2015

こんにちは
ヒットしたセルの文字色を変えるとして、
Sub test()
　　Dim v As Variant
　　Dim i As Long
　　Dim j As Long
　　Const 検索ワード As String = "検索する文字"
　　v = Range("A1").CurrentRegion.Value
　　For i = 1 To UBound(v, 1)
　　　　If v(i, 1) = "位置" Then
　　　　　　For j = 1 To UBound(v, 2)
　　　　　　　　If v(i, j) = 検索ワード Then
　　　　　　　　　　Cells(i, j).Font.Color = vbGreen
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　Next
End Sub

お礼

ありがとうございます。(_ _)
シンプルで非常に分かりやすかったです。
問題なく出来ました。

他の方へも同じ質問をしているのですが、
1hit目2hit目を判別する事は出来ますか？

回答No.4

kagakusuki

回答No.3です。

　もし、Findメソッドの処理速度が遅い事を少しでも軽減するために、「位置の行」のみを検索する様にしたいという事でしたら、一例としては次の様なVBAとなります。

Sub Sample2()

Dim FoundCell As Range, FirstCell As Range _
, Target As Range, c As Range, SearchRow As Range

For Each c In Range("A1:A" _
& Range("A" & Rows.Count).End(xlUp).Row)
If c.Value = "位置" Then
If SearchRow Is Nothing Then
Set SearchRow = c.EntireRow
Else
Set SearchRow = Union(SearchRow, c.EntireRow)
End If
End If
Next c

If Not SearchRow Is Nothing Then
Set FoundCell = SearchRow.Find(What:="文字列")
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
Set Target = FoundCell
Do
Set FoundCell = SearchRow.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
Set Target = Union(Target, FoundCell)
End If
Loop
End If
End If
If Target Is Nothing Then
MsgBox "見つかりません"
Else
Target.Select
MsgBox Target.Count & "件見つかりました"
End If
Exit Sub

End Sub

お礼

ありがとうございます(_ _)
問題なく動作しました。
紐解きながら後学の参考にさせていただきます(_ _)

もう一つだけ質問なのですが、位置列で同じ検索ワードが２以上あった場合にも対応していますが、1回目のhit 2回目のhit を判別する方法はどこを見ればいいですか？

回答No.3

kagakusuki

Findメソッドを使って検索してヒットしたセルをどうしたいのでしょうか？
　該当するセルのみを全て選択した状態にしたいのですか？
　それとも該当するセルが何個あるのかを調べたいのですか？

　もしそういった目的である場合には、Findメソッドを使ってシート全体を検索し、見つかった「目的の文字列が入力されている複数のセル」の内、A列に「位置」と入力されていないセルに関しては除外する事で、A列に「位置」と入力されているセルのみを取り出すようにすれば済む話ではないでしょうか?
　下記のVBAは、Findメソッドを使って、「文字列」と入力されているセルを検索し、該当するセルの内、A列に「位置」と入力されている行にあるセルのみをまとめて変数Targetに格納するVBAです。

Sub Sample()

Dim FoundCell As Range, FirstCell As Range, Target As Range

Set FoundCell = Cells.Find(What:="文字列")
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
GoSub Label_Found
Do
Set FoundCell = Cells.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
GoSub Label_Found
End If
Loop
End If
If Target Is Nothing Then
MsgBox "見つかりません"
Else
Target.Select
MsgBox Target.Count & "件見つかりました"
End If
Exit Sub

Label_Found:
If Range("A" & FoundCell.Row).Value = "位置" Then
If Target Is Nothing Then
Set Target = FoundCell
Else
Set Target = Union(Target, FoundCell)
End If
End If
Return

End Sub

回答No.2

Prome_Lin

すみません、「Find」を使った場合の、質問のやり方が分からなかったので、この回答は無視して頂いて結構です。

Option Explicit
Sub Test()
Dim i, j As Long
Const s = "ABC"
For i = 1 To Range("A1").End(xlDown).Row
If Cells(i, 1).Value = "位置" Then
For j = 2 To Range(Cells(i, 2), Cells(i, Columns.Count)).End(xlToRight).Column
If Cells(i, j).Value = s Then
Cells(i, j).Interior.ColorIndex = 3
End If
Next j
End If
Next i
End Sub

簡単な説明です。

Const s = "ABC"

の「ABC」が検索文字です。

あとは、単に、すべての行を順番に調べて行き、その行の「１列目（Ａ）」に「位置」という文字があれば、その横から、その行の最後の文字までを、順番に調べて行き、もし、「ABC」が見つかれば、そのセルの色を赤く塗りつぶしています。

このマクロの場合、検索文字が見つかったセルの位置は、「i」と「j」の値によって、分かります。

鈍くさいマクロで申し訳ございません。

ただ、処理速度的には、よほどデータが多くない限り、そんなにかからないのでは？

しかし、質問のやり方と異なりますので、もし、勉強のために質問されているのでしたら、ご希望に添えず、申し訳ございません。

お礼

ありがとうございます(_ _)
紐解きながら後学の参考にさせていただきます。
記載した表では問題なく出来ました。

ただ、全ての行とあるのですが、範囲が広がると上手く動作しなかったです。A列に「位置」はあるのですが・・。

回答No.1

nan93850673

FindNext()
じゃダメなの？

お礼

回答ありがとうございます。
FindNext()を調べてみたのですが現状ではうまくできなかったかため、
もう少し勉強してみます。(_ _)