質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.80%

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

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 2
  • VIEW 159K+

score 14

100行3000列ほどのエクセルデータから
キーワード=項目 が一致する列を抽出したいです。
![イメージ説明上記のようなデータ一覧から
   A    B   C
1 年賀状  氏名  誕生日



のように、キーワードを選択して
その列に入ってる値をすべて抽出したいです。

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

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

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

ご教授のほどよろしくお願い申し上げます。
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

+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/13 11:01

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

    キャンセル

0

追記

要望を読み間違えていたようですので追記します。
すること:任意数指定したキーワードの列を元データから抜き出して別シートにコピーする
手順:
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/10 03:27

    VBAで行いたい理由が説明がうまく伝えられず申し訳ありません。

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

    オートフィルターだと
    キーワード=項目の場合
    項目に属する値となってしまい、
    参考URLにあるような
    項目名:名前
    値:田中
    だと値となる「田中」だけを選択する
    もしくはセルの場所を指定して抽出するものになってしまいます。

    オートフィルターでは項目から
    その項目に対して入力されている列すべてを指定しきれません。
    (データ量が多く、変動するため毎回指定できません。)

    参考にしたと記載している 【マクロ】検索に一致した条件とその下のセルを抽出  
    の投稿では、項目入力されている列すべてが取り出せるので
    理想型に近いのですが、検索対象を行すべてに記述する必要があるので
    元のデータ量からして記述しきれません。
    データ数やデータ項目が変動するのでVBAで処理したくお伺いしております。

    もし、希望に沿うような記述方法があれば
    ご教授くださいませ。よろしくお願いいたします。

    キャンセル

  • 2015/10/10 04:00 編集

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

    キャンセル

  • 2015/10/10 13:46 編集

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

    それとも、元シートのカラム数が多いので、目的に応じて使用するカラムだけからなる小さな表を生成したいという意味ですか?

    キャンセル

  • 2015/10/10 14:57

    >hirohiroさん
    なんどもご丁寧にありがとうございます。
    追記いただいた参考URL確認いたしました。
    流れとしましては
    指定した複数キーワード=項目名を読み出すー>
    (行は変動で大量にある)指定したキーワード=項目名を列ごと全て取得ー>
    別シートにペースト

    これをキーワード分反復することで
    可能とのことでしょうか?

    キーワード検索に対しての参考URL
    拝見いたしましたが、少し意図していたものとは
    違う値が抽出されてしまいました。

    大量にあるデータから
    指定したキーワード=項目名に属する
    全ての値=列を全部取り出したいです。

    かなり近いところまでくることができていますので
    引き続き動作させて調整してみたいと思います。

    もしまた、他の記述方法がございましたら
    ぜひご教授くださいませ。

    >pi-chanさん

    オートフィルターでは

    キーワード=項目名とした場合

    キーワードに属する値=列に入ってる値

    のみが抽出されるようになってしまい。
    大量にあるデータ(少なくとも100行3000列)から
    取り出したいキーワード=項目名 を指定することで
    項目名以下の列全てを抽出したいというものです。

    検索条件としては「キーワード=項目名に属する列ごと抽出する」
    というものになるかと思います。

    >それとも、元シートのカラム数が多いので、目的に応じて使用するカラムだけからなる小さな表を生成したいという意味ですか?

    知識不足で申し訳ありません。
    行セルのことをカラムとするならば
    おっしゃるとおりです。
    行の位置、個数に依存せず
    元データをシート全範囲として検索対象にしたうえで
    その都度指定するキーワード=項目名を検索することで
    キーワードに属する列全てを抽出する(小さい表を作成したい)というものです。

    もし、うまく動かすことができる記述方法を
    ご存知でしたら、ご教授くださいませ。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.80%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る