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

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

新規登録して質問してみよう
ただいま回答率
85.44%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

2回答

173655閲覧

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

ellebecca

総合スコア14

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

2クリップ

投稿2015/10/09 16:31

編集2015/10/09 16:33

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



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

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

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

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

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

気になる質問をクリップする

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

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

こんな感じのことをお望みなのでしょうか?
列コピーの説明図

《 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

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

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/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列)から 取り出したいキーワード=項目名 を指定することで 項目名以下の列全てを抽出したいというものです。 検索条件としては「キーワード=項目名に属する列ごと抽出する」 というものになるかと思います。 >それとも、元シートのカラム数が多いので、目的に応じて使用するカラムだけからなる小さな表を生成したいという意味ですか? 知識不足で申し訳ありません。 行セルのことをカラムとするならば おっしゃるとおりです。 行の位置、個数に依存せず 元データをシート全範囲として検索対象にしたうえで その都度指定するキーワード=項目名を検索することで キーワードに属する列全てを抽出する(小さい表を作成したい)というものです。 もし、うまく動かすことができる記述方法を ご存知でしたら、ご教授くださいませ。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.44%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問