[[20110709004956]]　『コンボボックスの値で振り分け』（くみ）　ページの最後に飛ぶ

『コンボボックスの値で振り分け』（くみ）

 Excel2003使用です。
 いつもお世話になってます。
 リストからデータを抽出して別シートへ転記したいと考えてます。

 1_台帳　という名前のシートに

 　　 A　　　B　　　C　　　D　　　E　　・・・・
 1
 2   日付　番号　担当者　品名　　個数　・・・・
 3　 4/01　001　　田中　コーラ　　1　　・・・・
 4　 4/02  002　　佐藤　サイダー  2　　・・・・
 5　 4/02  003    田中　ラムネ　　1　　・・・・
 6　 4/03  004    小島　コーヒー　3　　・・・・
 7　 4/04  005 　 佐藤　ラムネ　　2　　・・・・
 ・
 ・
 ・　と入力があります。1年で1500行程のデータになります。

 例えば、1行目あたりに担当者名を選択できるコンボボックスとマクロ実行ボタンを作って
 担当者名を選択した後にボタンを押すと、コンボボックスで選択した担当者名で
 C列をオートフィルターかけて、結果をコンボボックスで選択した担当者名と
 同じシートに転記したいのです。担当者名と同じ名前のシートは既に作成済です。

 コンボボックスで「田中」を選択してマクロ実行した場合

 sheet名「田中」
  　　 A　　　B　　　C　　　 D　　 
 1   日付　 番号　　品名　　個数
 2　 4/01　 001　　コーラ　　1
 3　 4/02   003  　ラムネ　　1
 4

 となるようにしたいのです。（振り分け後には、担当者名はいらない）
 マクロの記録で、オートフィルタかけてコピペするのはできたのですが
 コンボボックスで選択したのと同じ値でオートフィルタとか
 同じ名前のシートにペースト…とかなると、どうすればよいのか解りません。
 一応以下がマクロの記録でできたモジュールです。

 Sub 振り分け()

  Selection.AutoFilter Field:=7, Criteria1:="田中"
  Range("A3:B3").Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy
  Sheets("田中").Select
  Range("A2").Select
  ActiveSheet.Paste
  Sheets("1_台帳").Select
  Range("D3:E3").Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("田中").Select
  Range("C2").Select
  ActiveSheet.Paste
  Range("A3").Select
 End Sub

 何をどのように付け加えればよいのか、ご指導いただけませんか。

 １．
 表が1行目からに成るように配置して
 　　コンボボックスとマクロ実行ボタンはA列に作るとか
 　　別シートに作るとかして。。。
 フィルタオプションの設定で抽出するのがコードの修正をするのも
 簡単に成るのではないかと思います。

 ２．
 最後の列が値で終わるなら（サンプルで、表の最後（D列）は個数（値）に成っています）
 ピボットテーブルで代用出来るかもしれません。
https://www.excel.studio-kazu.jp/lib/e2d/e2d.html
 ライブラリ「ピボットテーブル入門 [Excel2003版]」

 ページのフィールド　担当者
 行のフィールド　　　日付　番号　品名
 データアイテム　　　個数

 ページのフィールドで担当者を絞り込んだり出来ますので
 人数分のページを作る必要が無くなるんじゃないかと思います。
 　データに変更が在った場合は　更新が必要ですが。。。
 　現在の作りであればその点の条件は同じ様な気がします。

 ３．
 載せて居られる方法を決行するなら。。。
 　コンボボックスが、フォームのコンボボックスだった場合
 　リンクするセルをA1セルとかにして、B1セルにINDEX関数等で選択している人の名前を表示する。
 　コード内の「"田中"」と成っている所を　Range("B1").Value　に変更。
 で動くのではないかと思いますが。
 あ、データ量が減った時の事を考えて　コピー前に貼付先のシートのデータは
 削除しておくのが良いかもしれません。。。

 (HANA)

HANAさん、有難うございます。

 ２．のピボットテーブルは、この先項目数がかなり増える可能性があるので
 やめました。元々この台帳の作成管理は他の方がやっており、別シートに
 振り分けた後に何かやりたいようです。

 ３．で教えていただいた方法で上手くいきました。
 なるほど。こういう方法でやればいいのか。とスッキリです。
 アドバイスいただいた貼付先シートのデータ削除は、おっしゃるとおりですので
 組み込ませていただきました。勉強になります。

 １．のフィルタオプションを使う方法がいまいち解らないので
 もう少し自分で試行錯誤して試してみようかと思います。
 どうしても解らなければ、教えてください。
 その時はよろしくお願いします。

 （くみ）

 おすすめとしてはHANAさんが一番目にあげておられるフィルターオプション。
エクセル上の操作でやっても、簡単にできるし、ＶＢＡ化しておくのも割合と簡単。
おなじフィルターでもオートフィルターより扱いやすいと個人的には思う。
(オートフィルタは抽出条件をコードで与えることができるけどフィルターオプションはシート上に検索欄を設ける必要があるのが難点だけど）

 いずれにしてもエクセルのフィルター機能が優れものだと思う。
参考までに、アップされたオートフィルターのそのままのコードに、絞り込み条件を変数にしたものを 振り分け2 として。
それを、少し整理したものをSample2として、またフィルターオプションを使ったものをSample1として。

 いずれも、レイアウトは今のまま２行目がタイトル、コンボボックスで選んだ値が、仮にC1 にリンクされているという前提。

 Sub 振り分け2()
    Dim myName As String
    myName = Range("C1").Value  'コンボボックスで選んだ値のリックされているセル
    Selection.AutoFilter Field:=3, Criteria1:=myName   '★
    Range("A3:B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(myName).Select  '★
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("1_台帳").Select
    Range("D3:E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(myName).Select  '★
    Range("C2").Select
    ActiveSheet.Paste
    Range("A3").Select
 End Sub

 Sub Sample1()
    Dim x As Long, y As Long, z As Long
    Dim myName As String
    Dim sh As Worksheet

    With Sheets("1_台帳")
        myName = .Range("C1").Value  'コンボボックスで選んだ値のリックされているセル
        If Not IsObject(Evaluate(myName & "!A1")) Then
            MsgBox "シート: " & myName & "がありません"
        Else
            Set sh = Sheets(myName)
            x = .Cells(2, .Columns.Count).End(xlToLeft).Column
            y = .Range("A" & .Rows.Count).End(xlUp).Row
            z = x + 2 '作業列
            .Cells(1, z).Value = .Range("C2").Value '氏名タイトル
            .Cells(2, z).Value = myName
            sh.Cells.ClearContents
            sh.Range("A1:B1").Value = .Range("A2:B2").Value
            sh.Range("C1:D1").Value = .Range("D2:E2").Value
            .Range("A2").Resize(y - 1, x).AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=.Cells(1, z).Resize(2), CopyToRange:=sh.Range("A1:D1"), Unique:=False
            .Cells(1, z).Resize(2).ClearContents
            Set sh = Nothing
        End If
    End With

 End Sub

 Sub Sample2()
    Dim myName As String
    Dim sh As Worksheet

    With Sheets("1_台帳")
        myName = .Range("C1").Value  'コンボボックスで選んだ値のリックされているセル
        If Not IsObject(Evaluate(myName & "!A1")) Then
            MsgBox "シート: " & myName & "がありません"
        Else
            Set sh = Sheets(myName)
            sh.Cells.ClearContents
            sh.Range("A1:B1").Value = .Range("A2:B2").Value
            sh.Range("C1:D1").Value = .Range("D2:E2").Value

            .Range("A2").AutoFilter Field:=3, Criteria1:=myName
            .AutoFilter.Range.Columns("A:B").Copy sh.Range("A1")
            .AutoFilter.Range.Columns("D:E").Copy sh.Range("C1")
            Application.CutCopyMode = False
            .AutoFilterMode = False
            Set sh = Nothing
        End If
    End With

 End Sub

 ぶらっと立ち寄り

ぶらっと立ち寄りさん

 コード3つもありがとうございます!!!
 フィルタオプションは今まであまり使ったことがなかったのですが
 使ってみると便利ですね。
 正直、ＶＢＡ化するとこういう風になるんだ…とキョトンとしていますが。
 マクロの記録でとったコードも、整理するとずいぶん変わるんですね。
 やっぱり、変数の宣言とかからちゃんと勉強しないとダメですね。
 色々勉強になりました。

 どの方法を使うかは相談して決めたいと思います。
 今後も役立つので大変助かりました。
 HANAさん、ぶらっと立ち寄りさん、有難うございました。

 (くみ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110709004956]] 『コンボボックスの値で振り分け』（くみ） ページの最後に飛ぶ

[[20110709004956]]　『コンボボックスの値で振り分け』（くみ）　ページの最後に飛ぶ