| 
    
     |  | ▼kanabun さん: >▼kiki さん:
 >おじゃまします。
 >
 >>今後の勉強のためにも複数件あるデータを検索して転記する方法を
 >
 >[Sheet2]のA列にあるリストに重複はなかったですか?
 >
 >一般機能ですが、
 >フィルタオプションで、その[Sheet2]A列を抽出条件(リスト)範囲とすると
 >簡単なコードで、リストにあるデータだけ[Sheet2]に抽出できますよね
 >
 >それをマクロにしたものが、以下です。
 >
 >
 >Sub Try1() 'Sheet1より抽出転記、並び替え
 >  Dim Rng1 As Range
 >  Dim Rng2 As Range
 >  Dim Rng3 As Range
 >
 >  With Worksheets("Sheet1")
 >    '[Sheet1]1行目には A列から必要列まで(F1, F2,F3, F4,... F30のように)
 >    '    列見出しが入っているものと仮定しています
 >    Set Rng1 = .Range("AD1", .Cells(.Rows.Count, 1).End(xlUp))
 >  End With
 >  With Worksheets("Sheet2")
 >    If Not .Cells(1).HasFormula Then
 >      .Rows(1).Insert
 >      .Cells(1).Formula = "=Sheet1!D1"
 >    End If
 >    Set Rng2 = .Range("A1", .Cells(1).End(xlDown)) '抽出リスト
 >    Set Rng3 = .Range("C1").Resize(, Rng1.Columns.Count)
 >  End With
 >  Rng3.EntireColumn.ClearContents
 >  Rng3.Rows(1).Value = Rng1.Rows(1).Value '列見出しをコピーします
 >
 >  'A列にリストのあるデータ行だけ転記します(フィルタオプション)
 >  Rng1.AdvancedFilter xlFilterCopy, Rng2, Rng3
 >
 >  '転記後、第4列で並び替えます
 >  Rng3.CurrentRegion.Sort Key1:=Rng3.Columns(4), Order1:=xlAscending _
 >    , Header:=xlYes
 >
 >End Sub
 >
 >
 >なお、[Sheet2]A列の抽出リストが 単純な昇順リストとかになっていないときは
 >並び替えのオプションをユーザー定義で 「[Sheet2]A列の抽出リスト」を追加し
 >てこのSortOrderで並び替えてやる方法があります。(単純な昇順リストのほう
 >が、あとで読みやすいと思われますが)
 
 kanabun さん
 
 お返事ありがとうございました。
 大変勉強になります。
 そういう方法でも良いのですね。
 
 ちなみに、上記で再度質問させていただいたことには対応可能でしょうか><
 長文、仕様追加で申し訳ございません。
 
 |  |