[[20120517141051]]　『抽出データ』（いずみっち）　ページの最後に飛ぶ

『抽出データ』（いずみっち）

　マクロでSheet1のデータをSheet2に抽出してコピーしたいのですが・・・
　検索キーワードが3種類ありまして、そのうちのひとつが3列に対応しています。
　うまく説明できませんが宜しくお願い致します。

 Sheet1
     　A　　　　B        　 C      　D        　　  E      　　 F     　　　　
  1　社員番号　配送　　　A店  　 　 B店　　　　　C店   　　　倉庫
  2   101        C     きゃべつ　　　　　　　　きゃべつ　　　1-2東
  3   103        D                きゃべつ　　　　　　　　 　1-2東
  4　 102        D     りんご　　　　　　　　　　　　　　　  1-2東
　5   103        E                 りんご                    1-1西
  6   202        A    バナナ                   にんじん　　  1-1西
　
　Sheet2
   A2のセルに　103と入力はすると
        A      B      C     
  1  社員番号　配送　　品物
  2　  103
   　Sheet2のA10セルからSheet1の抽出データを表示 
　10 社員番号　　配送　　　A店　　　　B店     C店　　　　倉庫
　11　103        D               きゃべつ　 　　　　　　1-2東
　12　103        E                りんご                1-2西   　
　
  Sheet2
  B2セルに　Dと入力はすると
         A      B      C     
  1  社員番号　配送　　品物
  2　           D   
    Sheet2のA10セルからSheet1の抽出データを表示 
 10  社員番号　配送　　A店　　　　B店      C店　　　　倉庫
 11　 103        D               きゃべつ　       　　1-2東
 12   102        D    りんご                          1-2東

  Sheet2
  C2セルに  りんご　と入力すると               
        A       B     　 C     
  1  社員番号　配送　　品物
  2　                 りんご
 Sheet2のA10セルからSheet1の抽出データを表示 
 　  社員番号　配送　　A店　　　B店      C店　　　　倉庫
　　102         D     りんご   　　　　　　　　 　　1-2東
    103　       E             　りんご              1-1西
 となるようにしたいのですが、どうか宜しくお願い致します。
　 [Excel2007,WindowsXP]

 こんなのでいいかな…？
 Sheet2のシートモジュールへ下記コードを貼り付けてみて下さい。
 それと、あらかじめ1行目と10行目に見出しを入力しておいてください。
 実際に店舗数が3つではないでしょうから、コメントの部分の範囲を適宜変更してください。

 Private Sub Worksheet_Change(ByVal Target As Range)

 Dim a As Range, tbl As Range
 Dim l_row As Long, l_row2 As Long, r As Long

 If (Not Intersect(Target, Range("A2:C2")) Is Nothing) Then
    If Target.Count = 1 Then
       Application.EnableEvents = False
       Range("A11:F10000").Clear
       If Target.Value <> "" Then
          l_row = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
          With Sheets(1)
             Set tbl = Choose(Target.Column, .Range("A2:A" & l_row), .Range("B2:B" & l_row), .Range("C2:E" & l_row)) '適宜変更
          End With
          For Each a In tbl
             If a.Value = Target.Value Then
                l_row2 = Range("A" & Rows.Count).End(xlUp).Row + 1
                If r <> a.Row Then
                   Sheets(1).Rows(a.Row).Copy Rows(l_row2)
                End If
                r = a.Row
             End If
          Next a
       End If
    End If
 End If
 Application.EnableEvents = True
 End Sub

 (Jera)

 Jera 様

 ありがとうございました。
 自分で範囲を変えたり色々と試してみます。
 本当にありがとうございました。
 (いずみっち)

コメント返信：

[ 一覧(最新更新順) ]

[[20120517141051]] 『抽出データ』（いずみっち） ページの最後に飛ぶ

[[20120517141051]]　『抽出データ』（いずみっち）　ページの最後に飛ぶ