[[20120807171352]]　『詳細をﾏｸﾛで作成』（サガス）　ページの最後に飛ぶ

 『詳細をﾏｸﾛで作成』（サガス）
 LTのBEST5のA2からA5の注文No,をLTdataの一覧から探し出しBCD列を連れてLT
 詳細のように表したいのですが、ﾏｸﾛでご指導お願いします。注文No,の境目は3行
 空けたいとおもいます。

 それか、LT BEST5のA2をｸﾘｯｸしたら、またはﾎﾞﾀﾝを押したら
 下記に表すようなLT 詳細が出てくるようにしたいのですが、初心者にとって
 簡単な方をご指導お願いします。

 ﾌｧｲﾙ名 LT.xls     ﾌｧｲﾙ名 LTdata.xls   　　　　ﾌｧｲﾙ名 LT.xls
 ｼｰﾄ名 BEST5       ｼｰﾄ名 一覧                   ｼｰﾄ名 詳細

    A              A         B  　C     D　　　　A      B    C     D
 1 注文No,      1 注文No,   ｻｲｽﾞ開始日 量   1 注文No,  ｻｲｽﾞ 開始日 量
 2 AB0001C1　　 2 BC0003C1　 L  8/1    30   2 AB0001C1  S 　7/20　 20　
 3 AB0002C1     3 DE0001C2   M  8/3　　20   3 AB0001C1  S   7/21   20   
 4 AB0003C1     4 AB0001C1   S  7/20   20   4 AB0001C1  S   8/1    20
 5 AB0004C1     5 AB0001C1   S  7/21　 20   5 AB0001C1  S   8/4    20
 6 AB0005C1     6 ABOOO1C1   S  8/1    20   6 AB0001C1  S   8/7    20
                7 ABOOO1C1   S  8/4    20
                8 AB0001C1   S  8/7    20
                9 EF1234C2   M  7/18   40

 エクセル標準機能のフィルターオプションを使う例。
 実行時には２つのブックが開かれていることが前提。

 Sub Sample()
    Dim c As Range
    Dim BEST5 As Worksheet
    Dim DtlSh As Worksheet
    Dim DataSh As Worksheet
    Dim i As Long

    Application.ScreenUpdating = False

    Set DataSh = Workbooks("LTdata.xls").Sheets("一覧")
    Set BEST5 = Workbooks("LT.xls").Sheets("BEST5")
    Set DtlSh = Workbooks("LT.xls").Sheets("詳細")

    DtlSh.Cells.ClearContents   '作業前に詳細シートの全セルをクリア
    '詳細シートのE列を作業列として使用
    DtlSh.Range("E1").Value = DataSh.Range("A1").Value   '注文No タイトル
    i = 1   '転記行番号
    'BEST5のA2からA列最終行までセルを１つずつ取り出す
    For Each c In BEST5.Range("A2", BEST5.Range("a" & BEST5.Rows.Count).End(xlUp))
        DtlSh.Range("E2").Value = c.Value 'フィルター抽出キー
        'フィルターオプションによる抽出実行
        DataSh.Columns("A:D").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DtlSh.Range("E1:E2"), _
            CopyToRange:=DtlSh.Range("A" & i), Unique:=False
        i = DtlSh.Range("A1").CurrentRegion.Rows.Count + 1  '次の転記行
    Next
    'フィルターで抽出したデータの2番目以降のタイトル行をクリア
    For Each c In DtlSh.Range("A2", DtlSh.Range("A" & DtlSh.Rows.Count).End(xlUp))
        If c.Value = DtlSh.Range("E1").Value Then c.Resize(, 4).ClearContents
    Next
    '作業列クリア
    DtlSh.Columns("E").ClearContents

    DtlSh.Parent.Activate
    DtlSh.Activate
    Application.ScreenUpdating = True

    MsgBox "抽出完了しました"

 End Sub

 (ぶらっと)

 ぶらっとさん、希望どおりのものが出来ました。一つ一つゆっくり見させて
 いただきます。ご指導ありがとうございました。
 (サガス)

コメント返信：

[ 一覧(最新更新順) ]

[[20120807171352]] 『詳細をﾏｸﾛで作成』（サガス） ページの最後に飛ぶ

[[20120807171352]]　『詳細をﾏｸﾛで作成』（サガス）　ページの最後に飛ぶ