[[20171205173635]] 『マクロで特定の行を抽出』(ZET) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『マクロで特定の行を抽出』(ZET)

Sheet1のA1セルに日付,B1セルに客先名,C1セルに品名の見出しがあるとします。
特定の客先をSheet2へ抽出したいのです。
Sheet2のB1セルに客先名を入力すればSheet1から合致する客先の行を抜き出す事は出来ますか?
その時によって抽出したい客先を変えたいのです。
関数で試しましたがSheet1の行数が1万超えてますのでマクロでやりたいと思います。どうかひとつよろしくお願いします。

< 使用 Excel:Excel2007、使用 OS:Windows10 >


>Sheet2のB1セルに客先名を入力すれば

B1セルでなくてもければ、フィルタオプションでできます

>Sheet1の行数が1万超えてますのでマクロでやりたいと思います。

フィルタオプションなら手作業でもできますが
ネットで検索すれば、簡単にサンプルコードは入手できますし
「マクロの記録」を叩き台に作成してもよいと思います。

(マナ) 2017/12/05(火) 20:15


オートフィルターで抽出して転記のほうが楽だったかもしれません。

(マナ) 2017/12/05(火) 20:17


返信ありがとうございます。
もちろんフィルターの事は存じております。
sheet2のB1セルにはプルダウンで客先を登録してまして、
客先を選択してマクロボタンで抽出出来るようにしたかったのですが、
難しそうですね。
ありがとうございました。

(ZET) 2017/12/06(水) 10:43


Sub main()
    Dim r As Range
    Set r = Sheets("Sheet1").Range("B:B").Find(Sheets("Sheet2").Range("B1"), , , xlWhole)
    If Not r Is Nothing Then
        r.EntireRow.Copy Sheets("Sheet2").Range("A1")
    Else
         MsgBox Sheets("Sheet2").Range("B1") & ":該当無し": Sheets("Sheet2").Rows(1).ClearContents
    End If
End Sub
(mm) 2017/12/06(水) 10:57

mm様返信ありがとうございます。
さっそく教えていただいたコードを試してみたのですが、
抽出されるのは1行のみでした。
該当するすべての行を抽出することは出来ないのでしょうか?
時間に余裕がありましたらよろしくお願いします
(ZET) 2017/12/06(水) 16:01

Sub main()
    Dim r As Range, p As Range, f As Range, dt As String
    dt = Sheets("Sheet2").Range("B1")
    Sheets("Sheet2").Cells.ClearContents
    Sheets("Sheet2").Range("B1") = dt
    Set r = Sheets("Sheet1").Range("B:B").Find(Sheets("Sheet2").Range("B1"), , , xlWhole)
    Set p = Sheets("Sheet2").Range("A1")
    If Not r Is Nothing Then
        r.EntireRow.Copy p
         Set f = r
            Do
                Set r = Sheets("Sheet1").Range("B:B").FindNext(r)
                If r.Address = f.Address Then
                    Exit Do
                Else
                Set p = p.Offset(1)
                     r.EntireRow.Copy p
                End If
            Loop
    Else
         MsgBox Sheets("Sheet2").Range("B1") & ":該当無し": Sheets("Sheet2").Rows(1).ClearContents
    End If
End Sub
(mm) 2017/12/06(水) 16:21

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.