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

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

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

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

マクロ

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

Q&A

解決済

4回答

39828閲覧

エクセルVBA:特定の列だけ抽出して別ブックに転記したい

tsunana

総合スコア18

VBA

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

マクロ

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

0グッド

0クリップ

投稿2019/02/26 08:56

前提・実現したいこと

現在は条件が合った行すべてが出力されています。
↓それを
条件が合った内容の行を、さらに指定した列のみ(K,Q)だけを出力して別ブックに転記したい。

該当のソースコード

※個人的なパスやファイル名は伏せています。 Sub 抽出ボタン() ' 不要なダイアログ出力を抑制 Application.DisplayAlerts = False ' 画面の更新処理を停止 Application.ScreenUpdating = False 'ブックのパスを設定 Dim filePath As String filePath = "C:\○○○\Desktop\test1.xlsx" 'ブック作成 With Workbooks.Add ' 既存ブックから新規ブックへコピーするシートを指定する ' シート名もコピー元のシート名になる ' Field=左から数えた列 Criteria1:=抽出条件の指定 ThisWorkbook.Sheets(Array("マスタA")).Copy Before:=.Sheets(1) Range("A1").AutoFilter Field:=17, Criteria1:=">10" ' 新規作成したブックを保存する(※拡張子によってFileFormatが違う) .SaveAs fileName:=filePath, FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbook ' 新規作成したファイルを閉じる .Close End With End Sub

試したこと

ThisWorkbook.Sheets(Array("マスタA")).Copy Before:=.Sheets(1) Range("A1").AutoFilter Field:=17, Criteria1:=">10"

この行で「Criteria1:=">10"」(数値が10以上)の条件が合った行を抽出して、別ブックに転記される記述にしました。

このあと実現したいことに記載したように、さらに特定した列だけにしぼって出力したいのですが手が詰まってしまいました。

補足情報(FW/ツールのバージョンなど)

まだ手探り状態ですので、たくさんコメントアウトの記述がありますが気にしないでください。。

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

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

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

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

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

guest

回答4

0

条件が合った内容の行を、さらに指定した列のみ(K,Q)だけを出力して別ブックに転記したい。

この機能は、「フィルターオプション」という機能に実装されいます。

手動だと、手順が結構めんどいですし、不要にシートを汚すので、
スマートではないですが、VBAで制御するなら、驚くほどコードが簡素化出来て便利です。
ぜひ、使ってみてください。

投稿2019/03/10 14:51

mattuwan

総合スコア2136

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

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

0

もし「別のブックから、データのあるExcelファイルを覗きにいって、条件が合った内容の行を、さらに指定した列だけを(列番号ではなくて表の中の列名で)抽出して、その別のブックに表示したい。 」ということでもよろしければ、MicrosoftQueryが使いやすいと思います。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter2.htm
に簡単な事例があります。ここの「システムテーブル」のチェックだけ入れ忘れないようにしてください。

なお、Microsoft Query によって表示された表は、VBAでは「QueryTableオブジェクト」として操作することもできます。
そこでSQLでの命令文も使えますので、ワークシート関数を多用したり、ループなどを使ったプログラムを作るよりはらくちんではないかと思います。

以下のコードは「D:\test88\test01.xls」というファイルの「Sheet1]を覗きに行って、Sheet2に表示させます。
覗きに行く「Sheet1」は「"SELECT * FROM Sheet1$"」のところで指定してます。
長いSQL文は、各句ごとに、Arrayにてカンマで区切って、CommanText(配列)に格納します。
もし、CommanTextが配列じゃなかったら、カンマで区切らずに1行の長い命令文として格納します。

CommanTextが配列かそうじゃないかは、一つ何らかの複雑な条件のMicrosoftQueryの結果の表を手動で作ってみて、それのCommanTextの内容をVBAでイミディエイトに表示させ、複数行に分かれて出てきたら配列と思っていいです。1行だけなら配列じゃないかもです。
配列だったらArreyを使うし、配列じゃなかったら、Arreyは要りません。

周囲に、AccessやSQLがわかる人が居ましたら、こちらの方法も今後便利かと思います。
複数の条件であっても、1つ1つが複雑でないとか、リレーション(VlookUp関数のような紐つけ)も同時に使いながらとか、でしたら、通常のVBAでデータ抽出するよりははるかにラクです。

※こちらのテストでは、xlsにも、xlsmに対しても、覗きにいくことができました。
(ダメだったらすみません!)

なお、もし、何らかの条件で(K,Q)の列のみを取り出したいとこは、Arreyのところで、

SELECT K列に相当する列名, Q列に相当する列名 FROM シート名$ WHERE 条件としたい列名 >= 10;

みたいな感じで書きます。(SELECTやFROMなどの命令語句の前後には半角スペースが必要です。)
WHEREの条件句のところでは、OrやAndなども使って複数の条件が設定できます。

詳しくは、Webや先輩、分かる人などに聞いてみてください。

ここで書いたのはあくまで参考例ですので・・・。

※コメントがやたら長いので、不要なら全部消して見てみてください。
コード自体はかなり少ないです。

なお、他のブックに書き込みたいなら・・・、
・CreateObject関数・GetObject関数(実行時バインディング)、
あるいは、Newキーワード(事前バインディング)を使って
ファイルを非表示のまま開いて書き込む方法。
・閉じたファイルに書き込みたいなら、DAOやADOにて、
ループ+Update系メソッド又はSQL+Execute系メソッドを使って書き込む方法。
・・・などがあります。

Excel

1 2Sub test301() 3 4 Dim objQtbl01 As QueryTable 5 Dim strCnn01 As String 6 7 8 '接続文字が長くて見にくいので、見やすく扱いやすくする 9 10 strCnn01 = strCnn01 & "ODBC;" 11 strCnn01 = strCnn01 & "DSN=Excel Files;" 12 strCnn01 = strCnn01 & "DBQ=D:\test88\test01.xls;" 13 strCnn01 = strCnn01 & "DefaultDir=D:\test88;" 14 strCnn01 = strCnn01 & "DriverId=790;" 15 strCnn01 = strCnn01 & "MaxBufferSize=2048;" 16 strCnn01 = strCnn01 & "PageTimeout=5;" 17 18 'ここで書き換えるのは基本、 19 '「DBQ=・・・」のフルパスと、 20 '「DefaultDir」のフォルダパスと、 21 '「Destination・・・」のシート名や表の起点のセル(Rangeのところ) 22 'あと、次段階の「.CommandText = Array(・・・)」の行のそのSQLの内容 23 'でOKかと思います。 24 ' 25 26 'もしSheet2にMicrosoftQueryの結果の表(=QueryTablesオブジェクト)が 27 '無かったら、作って表示させる処理。 28 ' 29 30 If (Worksheets("Sheet2").QueryTables.Count <= 0) Then 31 32 'もしSheet2にMicrosoftQueryの結果の表が 33 '無かったら以下の処理 34 35 '以下の内容でSheet2にMicrosoftQueryの結果の表を作成。 36 'フルパスは恐らくUNCパス、つまり、他のPCの共有フォルダのxlsでも 37 '良いのではないかと思います。(ダメだったらすみません!) 38 39 ’空っぽいのMicrosoft QueryオブジェクトをSheet2のB2セルを起点に作る処理。 40 41 Set objQtbl01 = Worksheets("Sheet2").QueryTables.Add( _ 42 Connection:=strCnn01, _ 43 Destination:=Worksheets("Sheet2").Range("B2")) 44 45 46 '今回のこの例でのSQL文では、Sheet2に対して、 47 '「B2」セルを起点としてMicrosoftQueryの結果の表を作成します。 48 'この時点では、オブジェクトしては作成されているのですが、 49 'まだ条件設定とかしてないので、Sheet2には何も表示されません。 50 51 'なお、「Worksheets("Sheet2").」を「Activesheet.」に書き換えると、 52 '現在表示しているシートに結果の表が生成されます。 53 ' 54 'また、SQL文(表操作の命令文)の中では、 55 'test01.xlsのSheet1(=システムテーブル)のことを「`Sheet1$`」と 56 '表現しているのですが、これは「システムテーブルと認めさせるために、 57 'シート名に「$」を末尾に付けている・・・」ということになります。 58 'また、Microsoft QueryのSQLの仕様として、そのテーブル名を 59 '「`」バッククォートで囲んでいます。[ ] で囲んでもOKです。 60 'バッククォートはShiftキーを押しながら「@」を押します。 61 62 63 64 'QueryTablesオブジェクトのSQLを書き換え。 65 '(このサンプルでは、毎回、空っぽの状態にSQL文が入ります。) 66 objQtbl01.CommandText = Array("SELECT * FROM `Sheet1$`") 67 68 '書き換えたSQLを実行して表に反映。 69 '空っぽのMicrosoftQueryのオブジェクトの中に、SQL文で指定した内容の 70 '表ができあがる・・・みたいな雰囲気です。 71 'ここではじめて、表が表示されます。 72 '(もともと何も表示されてない場合は、表が自動的に新規作成されます。) 73 objQtbl01.Refresh 74 Exit Sub 75 76 Else 77 78 'もしすでに、Sheet2にMicrosoftQueryの結果の表が 79 'あったら何もしないで次へ。 80 81 End If 82 83 84' 'もし、作ったMicrosoft Queryの結果の表が表示されなかったら 85' '以下の2行のコメントアウトをはずしてテストしてみます。 86' Worksheets("Sheet2").QueryTables(1).CommandText = Array("SELECT * FROM `Sheet1$`") 'SQLの再指定 87' Worksheets("Sheet2").QueryTables(1).Refresh BackgroundQuery:=False 'SQLの実行と表示 88 89 90 91End Sub 92'

投稿2019/03/10 12:40

編集2019/03/11 02:46
komugi3333

総合スコア94

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

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

0

元シートでフィルターしたあと各列をコピペすれば必要なデータだけコピーされます。

VBA

1With Workbooks.Add 2 Set tgt = .Sheets(1) 3 Set base = ThisWorkbook.Sheets(1) 4 5 base.Range("A1").AutoFilter Field:=4, Criteria1:=">10" 6 7 c = 1 8 For Each a In Array("A", "C") 9 base.Range(base.Cells(1, a), base.Cells(1, a).End(xlDown)).Copy tgt.Cells(1, c) 10 c = c + 1 11 Next 12 .Close 13End With 14

投稿2019/02/27 13:28

退会済みユーザー

退会済みユーザー

総合スコア0

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

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

0

ベストアンサー

オートフィルタで列は絞れないので
「シートを丸ごとコピーするのではなく必要な列のみコピーする」
または
「オートフィルタの後に不要な列を削除する処理を入れる」
でどうでしょうか?

「特定した列だけにしぼって出力したい」というのが、「不要列のデータは削除せず残したい」という意味であれば
オートフィルタとは違いますが、「列の非表示」や「グループ化」になるかと思います。

投稿2019/02/27 02:07

kobac

総合スコア188

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

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

tsunana

2019/02/27 02:45

回答ありがとうございますm(__)m そうですね、、実際は元ブックの「K」「Q」列だけが別ブックに転記された状態であれば良いので処理的には「必要な列のみコピーする」や「オートフィルタの後に不要な列を削除する処理を入れる」でも良いかもしれません。あとは処理速度?でどっちが良いかになってくる感じですね。。
kobac

2019/02/27 03:06

一度すべてコピーしてから削除するよりは、最初から必要な列だけコピーする方が速いかと。 元ブックのデータ件数が多く、さらに計算式まで入っていたりすると、削除の際の再計算で遅くなりそうです。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.48%

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

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

質問する

関連した質問