【マクロ】選択した項目の列をすべて抽出して別シートへ

100行3000列ほどのエクセルデータから
キーワード＝項目が一致する列を抽出したいです。
![
上記のようなデータ一覧から
A B C
１年賀状氏名誕生日
２
３
｜
のように、キーワードを選択して
その列に入ってる値をすべて抽出したいです。

また、元のデータ量が変動しても、抽出する
キーワードが変更しても使いやすいように
「元のデータは」セル範囲指定でなく
シート全部もしくは編集中のセル全てを対象としたいです。

キーワードは可能であれば
元のデータとは別シートに記載すると
その別シートのキーワードの列（下）に反映されるようにしたいです。

以前に投稿されていた
【マクロ】検索に一致した条件とその下のセルを抽出
を参考に作成したのですが、
検索設定を行ごとに記述が必要なため、
変動する元のデータに対応しきれませんでした。
マクロを書き換えるのはキーワードが変更になった時だけに
なるような方法で記述するにはどうすれはいいでしょうか？

ご教授のほどよろしくお願い申し上げます。

行動規範の内容に同意します

回答2件

ベストアンサー

詳しい要件が分からないのと、あくまでもお試しなので、細かい点まで作りこんではいませんが…

こんな感じのことをお望みなのでしょうか？

《 Sheet1(列選択)シートのコード》
⇒「コピー実施」ボタンクリック時に実行される
⇒ 処理の本体を呼び出すだけ

Option Explicit

Private Sub btnCopy_Click()
    Call ColCopy
End Sub

《標準モジュール「列コピー」のコード》
⇒ コピー処理の本体

Option Explicit

Sub ColCopy()
    Dim xlBook As Workbook
    Dim xlSheetOrg As Worksheet
    Dim xlSheetSel As Worksheet
    Dim xlSheetDst As Worksheet
    Dim strDstSheetName As String
    Dim rngLastRow As Range
    Dim vntIndex As Variant
    Dim rngIndexs As Range
    Dim rngHeader As Range
    Dim lngColSrc As Long
    Dim lngColDst As Long
    Dim rngTargetCol As Range
    
    
    Set xlBook = ThisWorkbook
    
    With xlBook
        Set xlSheetSel = .Worksheets("列選択")
        Set xlSheetOrg = .Worksheets("オリジナル")
    End With
    
    ' コピー先シート名取得
    strDstSheetName = xlSheetSel.Range("A3").Value
    
    ' コピー先シートを初期化（なければ生成）
    On Error GoTo ERR_DST_SHEET
    Set xlSheetDst = xlBook.Worksheets(strDstSheetName)
    With xlSheetDst
        .Cells.Clear
    End With
    On Error GoTo 0
    
    
    ' 項目名を読み取り
    With xlSheetSel
        Set rngLastRow = .Cells(.Rows.Count, 1).End(xlUp)
        Set rngIndexs = .Range(.Cells(5, 1), rngLastRow)
        Set rngLastRow = Nothing
    End With
    
    ' 見出し行の取り込み
    Set rngHeader = xlSheetOrg.Rows(1)
    
    ' 該当列のコピー
    Application.ScreenUpdating = False
    With xlSheetDst
        lngColDst = 0
        For Each vntIndex In rngIndexs
            lngColDst = lngColDst + 1
            Set rngTargetCol = rngHeader.Find(CStr(vntIndex))
            lngColSrc = rngTargetCol.Column
            rngTargetCol.EntireColumn.Copy .Cells(1, lngColDst)
            Set rngTargetCol = Nothing
        Next vntIndex
        Set rngIndexs = Nothing
    End With
    Application.ScreenUpdating = True
    
    GoTo PROC_END
    
ERR_DST_SHEET:
    Set xlSheetDst = Sheets.Add(, Sheets("オリジナル"))
    xlSheetDst.Name = strDstSheetName
    Resume Next
    
PROC_END:
    Set rngHeader = Nothing
    Set xlSheetDst = Nothing
    Set xlSheetOrg = Nothing
    Set xlSheetSel = Nothing
    Set xlBook = Nothing

End Sub

投稿2015/10/10 19:55

pi-chan

総合スコア5936

ellebecca

2015/10/13 02:01

ありがとうございます。個数などに依存せず、うまく動作することができました！説明不足な点がおおいなか、ご丁寧にありがとうございました。

行動規範の内容に同意します

###追記
要望を読み間違えていたようですので追記します。
**すること：**任意数指定したキーワードの列を元データから抜き出して別シートにコピーする
手順：
1.　キーワードを一つ読み出す
2.　[1]のキーワードを元データのタイトル行から検索
3.　見つけた列を全てRangeに収める
4.　[3]をコピーし対象シートにペースト
5.　1-4をキーワード分繰り替えす。

行のデータ先頭からデータ端までをRangeに指定　参考
Set ttl = Range("A1").End(xlToRight)
キーワード検索　参考
Set Trg = ttl.Find(What:="年賀状")
見つけた列の末尾まで範囲を拡張
Set Trg = Trg.End(xlDown)
これをコピーして対象シートの一列目にペースト

実行環境が無く試せないので細かい所がうまく行くか不安ですが、こんな感じでどうでしょう？

###最初に投稿したもの
マクロでも同じことできますが、VBAで書くまでもなくExcel機能のオートフィルタでできそうに思います。
1行目を選択してオートフィルタを実行すれば、一行目の各列がプルダウンになり、その列に存在するデータが選択肢に並びます。
選択してフィルタ条件を設定すれば、条件に一致しない行が非表示になります。

VBAでやりたい場合もVBAからオートフィルタが設定できますので、それで実装するのが楽だと思います。
参考ページ
必要なだけオートフィルタを掛けて、必要な範囲を選択し、コピーして別のシートに貼り付け、という風に実装すれば可能かと思います。

投稿2015/10/09 18:18

編集2015/10/09 19:27

hirohiro

総合スコア2068

ellebecca

2015/10/09 18:27

VBAで行いたい理由が説明がうまく伝えられず申し訳ありません。＞また、元のデータ量が変動しても、抽出するキーワードが変更しても使いやすいように「元のデータは」セル範囲指定でなくシート全部もしくは編集中のセル全てを対象としたいです。オートフィルターだとキーワード＝項目の場合項目に属する値となってしまい、参考URLにあるような項目名：名前値：田中だと値となる「田中」だけを選択するもしくはセルの場所を指定して抽出するものになってしまいます。オートフィルターでは項目からその項目に対して入力されている列すべてを指定しきれません。（データ量が多く、変動するため毎回指定できません。）参考にしたと記載している　【マクロ】検索に一致した条件とその下のセルを抽出　の投稿では、項目入力されている列すべてが取り出せるので理想型に近いのですが、検索対象を行すべてに記述する必要があるので元のデータ量からして記述しきれません。データ数やデータ項目が変動するのでVBAで処理したくお伺いしております。もし、希望に沿うような記述方法があればご教授くださいませ。よろしくお願いいたします。

hirohiro

2015/10/09 19:08 編集

すみません。勘違いしてたようです。元300列ほどあるデータから、例えば「年賀状氏名誕生日」この3列だけを抜き出して別シートにコピーしたい。といったことでよかったでしょうか？手元にExcelが無いのでコード書いて試せないのですが、キーワードを一つ読み出す　->　データ1列目(要素タイトル)からキーワードを検索　->　HITした列名を取得　->　rangeにその列全てを設定　->　コピーして別シートにペーストこの流れを全キーワード分反復すればいけそうに思います。

pi-chan

2015/10/10 04:50 編集

横からスミマセン･･･「オートフィルターでは項目からその項目に対して入力されている列すべてを指定しきれません。」の意味がよく分からないので実装例も示せないのですが･･･特に大量のデータから目的のレコード(行)を高速に抽出する目的で、VBAからオートフィルターを制御して目的のデータ(行)のみを表示させた後、可視セル(今の場合は表示されている行全体)を別シートにコピーするというような方法は常套手段として使用されているのですが、オートフィルターが使えないというのは「具体的にどの様な要件なのでしょうか？」それと「検索条件をどの様に指定したい」のでしょうか？要件次第で実装方法が全く変わってしまうので、そのあたりをより具体的に示された方が回答を受けやすいです。それとも、元シートのカラム数が多いので、目的に応じて使用するカラムだけからなる小さな表を生成したいという意味ですか？

ellebecca

2015/10/10 05:57

＞hirohiroさんなんどもご丁寧にありがとうございます。追記いただいた参考URL確認いたしました。流れとしましては指定した複数キーワード＝項目名を読み出すー＞（行は変動で大量にある)指定したキーワード＝項目名を列ごと全て取得ー＞別シートにペーストこれをキーワード分反復することで可能とのことでしょうか？キーワード検索に対しての参考URL 拝見いたしましたが、少し意図していたものとは違う値が抽出されてしまいました。大量にあるデータから指定したキーワード＝項目名に属する全ての値＝列を全部取り出したいです。かなり近いところまでくることができていますので引き続き動作させて調整してみたいと思います。もしまた、他の記述方法がございましたらぜひご教授くださいませ。＞pi-chanさんオートフィルターではキーワード＝項目名とした場合キーワードに属する値＝列に入ってる値のみが抽出されるようになってしまい。大量にあるデータ（少なくとも100行3000列）から取り出したいキーワード＝項目名　を指定することで項目名以下の列全てを抽出したいというものです。検索条件としては「キーワード＝項目名に属する列ごと抽出する」というものになるかと思います。＞それとも、元シートのカラム数が多いので、目的に応じて使用するカラムだけからなる小さな表を生成したいという意味ですか？知識不足で申し訳ありません。行セルのことをカラムとするならばおっしゃるとおりです。行の位置、個数に依存せず元データをシート全範囲として検索対象にしたうえでその都度指定するキーワード＝項目名を検索することでキーワードに属する列全てを抽出する（小さい表を作成したい）というものです。もし、うまく動かすことができる記述方法をご存知でしたら、ご教授くださいませ。

行動規範の内容に同意します

あなたの回答