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

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

ただいまの
回答率

87.49%

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

解決済

回答 4

投稿

  • 評価
  • クリップ 0
  • VIEW 27K+

score 18

前提・実現したいこと

現在は条件が合った行すべてが出力されています。
↓それを
条件が合った内容の行を、さらに指定した列のみ(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/ツールのバージョンなど)

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

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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

回答 4

+1

条件が合った内容の行を、さらに指定した列のみ(K,Q)だけを出力して別ブックに転記したい。
この機能は、「フィルターオプション」という機能に実装されいます。

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

checkベストアンサー

0

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/27 11:45

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

    キャンセル

  • 2019/02/27 12:06

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

    キャンセル

0

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

With Workbooks.Add
    Set tgt = .Sheets(1)
    Set base = ThisWorkbook.Sheets(1)

    base.Range("A1").AutoFilter Field:=4, Criteria1:=">10"

    c = 1
    For Each a In Array("A", "C")
        base.Range(base.Cells(1, a), base.Cells(1, a).End(xlDown)).Copy tgt.Cells(1, c)
        c = c + 1
    Next
    .Close
End With

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

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系メソッドを使って書き込む方法。
・・・などがあります。

Sub test301()

    Dim objQtbl01       As QueryTable
    Dim strCnn01        As String


    '接続文字が長くて見にくいので、見やすく扱いやすくする

    strCnn01 = strCnn01 & "ODBC;"
    strCnn01 = strCnn01 & "DSN=Excel Files;"
    strCnn01 = strCnn01 & "DBQ=D:\test88\test01.xls;"
    strCnn01 = strCnn01 & "DefaultDir=D:\test88;"
    strCnn01 = strCnn01 & "DriverId=790;"
    strCnn01 = strCnn01 & "MaxBufferSize=2048;"
    strCnn01 = strCnn01 & "PageTimeout=5;"

                'ここで書き換えるのは基本、
                '「DBQ=・・・」のフルパスと、
                '「DefaultDir」のフォルダパスと、
                '「Destination・・・」のシート名や表の起点のセル(Rangeのところ)
                'あと、次段階の「.CommandText = Array(・・・)」の行のそのSQLの内容
                'でOKかと思います。
                '       

    'もしSheet2にMicrosoftQueryの結果の表(=QueryTablesオブジェクト)が
    '無かったら、作って表示させる処理。
    '

    If (Worksheets("Sheet2").QueryTables.Count <= 0) Then

        'もしSheet2にMicrosoftQueryの結果の表が
        '無かったら以下の処理

        '以下の内容でSheet2にMicrosoftQueryの結果の表を作成。
        'フルパスは恐らくUNCパス、つまり、他のPCの共有フォルダのxlsでも
        '良いのではないかと思います。(ダメだったらすみません!)

        ’空っぽいのMicrosoft QueryオブジェクトをSheet2のB2セルを起点に作る処理。

        Set objQtbl01 = Worksheets("Sheet2").QueryTables.Add( _
                        Connection:=strCnn01, _
                        Destination:=Worksheets("Sheet2").Range("B2"))


                '今回のこの例でのSQL文では、Sheet2に対して、
                '「B2」セルを起点としてMicrosoftQueryの結果の表を作成します。
                'この時点では、オブジェクトしては作成されているのですが、
                'まだ条件設定とかしてないので、Sheet2には何も表示されません。

                'なお、「Worksheets("Sheet2").」を「Activesheet.」に書き換えると、
                '現在表示しているシートに結果の表が生成されます。
                '
                'また、SQL文(表操作の命令文)の中では、
                'test01.xlsのSheet1(=システムテーブル)のことを「`Sheet1$`」と
                '表現しているのですが、これは「システムテーブルと認めさせるために、
                'シート名に「$」を末尾に付けている・・・」ということになります。
                'また、Microsoft QueryのSQLの仕様として、そのテーブル名を
                '「`」バッククォートで囲んでいます。[ ] で囲んでもOKです。
                'バッククォートはShiftキーを押しながら「@」を押します。



            'QueryTablesオブジェクトのSQLを書き換え。
            '(このサンプルでは、毎回、空っぽの状態にSQL文が入ります。)
            objQtbl01.CommandText = Array("SELECT * FROM `Sheet1$`")     

            '書き換えたSQLを実行して表に反映。
            '空っぽのMicrosoftQueryのオブジェクトの中に、SQL文で指定した内容の
            '表ができあがる・・・みたいな雰囲気です。
            'ここではじめて、表が表示されます。
            '(もともと何も表示されてない場合は、表が自動的に新規作成されます。)
            objQtbl01.Refresh                                            
            Exit Sub    

    Else

        'もしすでに、Sheet2にMicrosoftQueryの結果の表が
        'あったら何もしないで次へ。

    End If


'    'もし、作ったMicrosoft Queryの結果の表が表示されなかったら
'    '以下の2行のコメントアウトをはずしてテストしてみます。
'    Worksheets("Sheet2").QueryTables(1).CommandText = Array("SELECT * FROM `Sheet1$`")      'SQLの再指定
'    Worksheets("Sheet2").QueryTables(1).Refresh BackgroundQuery:=False          'SQLの実行と表示



End Sub
'

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

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

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

関連した質問

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