VBA 名前を検索して該当データを抜き出したいのですが…

Question

まずVBA 初心者のため拙い内容で申しわけありません！

VBA でブック内全てのシートから名前を検索し、該当する人のデータ(行)を抜き出そうとしています。
今はIFステートメントとFor NEXTステートメントでループさせて、１つのシートから抜き出すことはできるのですが、それ以上進めません。
やり方としては上記２つのステートメントを使用するコードでできるでしょうか？それともVLOOKUPを使ったりなど別の方法があるのでしょうか？

どなたか教えて下さい！できれば参考のコードなども教えていただけると助かります。よろしくお願いします！

TH69 · Accepted Answer

Worksheets.Count でシート数が分かるので、それを

a = Worksheets.Count
    For i = 1 To a
        if Worksheets(i)・・・

のようにしてループすれば同じやり方で行けるのでは。

あと、For Each～Next でも行けると思います。

tatsu99 · Answer

エラー処理等は考慮していませんが、とりあえず、これでどうでしょうか。
'追加のコメントがある行が、実際に追加した行です。ほかは変えていません。
---------------------------------------
Sub 氏名検索()
simei = InputBox("名前を入力")

With Worksheets("原本").Copy(after:=Worksheets("原本"))
ActiveSheet.Name = simei
End With

cnt = 2

For j = 1 To Worksheets.Count
If Worksheets(j).Name = "原本" Then GoTo CONT99 '追加
If Worksheets(j).Name = simei Then GoTo CONT99  '追加
For i = 2 To 2000
If Worksheets(j).Cells(i, 5) = simei Then
Worksheets(simei).Cells(cnt, 2) = Worksheets(j).Cells(i, 2)
Worksheets(simei).Cells(cnt, 11) = Worksheets(j).Cells(i, 11)
cnt = cnt + 1
Else
End If
Next i
CONT99: '追加
Next j

---------------------------------------

tom04 · Answer

こんばんは！

お望みの動きにならなかったらごめんなさい。

Sub Sample1()
    Dim k As Long, cnt As Long, simei As String, wS As Worksheet
    Dim myFound As Range, myFirst As Range, myFlg As Boolean
    simei = InputBox("名前を入力")
    With Worksheets("原本").Copy(after:=Worksheets("原本"))
            ActiveSheet.Name = simei
    End With
        Set wS = Worksheets(simei)
    cnt = 1
        Application.ScreenUpdating = False
        For k = 1 To Worksheets.Count
            With Worksheets(k)
                If .Name <> simei Then
                    Set myFound = .Range("E:E").Find(what:=simei, LookIn:=xlValues, lookat:=xlWhole)
                        If Not myFound Is Nothing Then
                            myFlg = True
                            cnt = cnt + 1
                            Set myFirst = myFound
                            wS.Cells(cnt, "B").Resize(, 10).Value = .Cells(myFound.Row, "B").Resize(, 10).Value
                        Do
                            Set myFound = .Range("E:E").FindNext(after:=myFound)
                            If myFound.Address = myFirst.Address Then Exit Do
                            cnt = cnt + 1
                            wS.Cells(cnt, "B").Resize(, 10).Value = .Cells(myFound.Row, "B").Resize(, 10).Value
                        Loop
                        End If
                End If
            End With
        Next k
        Application.ScreenUpdating = True
        If myFlg = False Then
            Application.DisplayAlerts = False
                wS.Delete
            Application.DisplayAlerts = True
            MsgBox "該当データなし"
        Else
            MsgBox "完了"
        End If
End Sub

※　「原本」シートの2行目以降にはデータがないとします。

こんな感じではどうでしょうか？m(_ _)m

tatsu99 · Answer

補足要求です。
質問１）検索対象となるシートは、”原本”もふくまれますか？
①原本
②原本をコピーしたシート（氏名のついたシート）
上記以外を検索すると理解して良いですか？
それとも、①②以外にも検索をスキップしたいシートはありますか。

質問２）検索対象シートを
①２～２０００行まで検索していますが、マッチデータがあった場合、その行以降の行にも、マッチデータが
ある可能性がありますか。（ないならそこで検索を打ち切ったほうが速い）
②２～２０００行まで検索していますが、途中で、空白行（Ｅ列が空白の行）があった場合、それ以降の行を
検索する必要がありますか。（ないならそこで検索を打ち切ったほうが速い）

TH69 · Answer

Worksheets.Countで全シートの数を出す前にシートの挿入を行っているため、そのシート自体もループの対象となっているように思います。

a=Worksheets.Count
With Worksheets("原本").Copy(after:=Worksheets("原本"))
ActiveSheet.Name = simei
End With

cnt = 2

For j = 1 To a
For i = 2 To 2000

のようにやってもうまく行かないでしょうか？
挿入するsimeiシートは必ず一番右になるようにして下さい。

Worksheets("原本").Copy(after:=Worksheets(a))

とか。

TH69 · Answer

Worksheets(1)はシート名に関係なく必ず左端のシートになります。以下、Worksheets(2)は左から2番目…となります。
ということで、For～Nextでやる時は左端もしくは右端のシートから順番にループすることになります。

>はじめのシート番号が変わる

のなら、その順番にシートを並び替えればとも思いますが、現実的じゃないですよね。

あとはシート名の一覧表を別に作り、それを並び替えてループするとか、並び替えずに番号を振ってその順番にするとか、考え方次第ですがどれも邪魔臭そうですね。

VBA 名前を検索して該当データを抜き出したいのですが…

エラー処理等は考慮していませんが、とりあえず、これでどうでしょうか。

こんばんは！

補足要求です。

Worksheets.Countで全シートの数を出す前にシートの挿入を行っているため、そのシート自体もループの対象となっているように思います。

Worksheets(1)はシート名に関係なく必ず左端のシートになります。

Worksheets.Count でシート数が分かるので、それを

似たような質問が見つかりました

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

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

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