条件に合う行だけを切り取り→別ブックに自動転記

質問

【環境】
Windows7 Office2013

【目的】
Excelで作ったcsvデータを、条件に合うものだけ抜き出して別ブックに自動で転記したい
（1つの表を2つに分けたい）

【詳細】
※オートフィルを使うという前提で説明しますが、目的の結果が得られるのであれば
　 オートフィル以外の方法でも構いません。

csvのデータがあります。

その中からオートフィルを使って「M列」で条件を選択（複数）し、その結果を
抜き出して（切り取って）別のブック（別シートではダメ）に自動転記したいです。

最終的に、元々の表Aから条件に合ったものだけを表Bとして保存。
表Aから表Bのデータを抜いたものは、そのまま表Aとして上書き保存。
・・・したいです（添付画像参照）

ネットで調べたところ、表の中に検索条件を入れる欄を作って・・・という方法
ならあったのですが、データ(ｃｓｖ）はそのままシステムに取り込むので
余計な欄を増やしたり等はできません。

そこで行き詰ってしまいました。

【表の詳細】
A～S列まであります。

項目名などの行は無く、1行目からデータが入っています。

※行数は、都度変化します。

M列の中から「90」「95」の物だけを抜き出して、表Bとしたい。

【やってみたこと】
オートフィルでの操作を「マクロの記録」で記録しようとしたのですが、
オートフィルの結果だけを「切り取る」ことが出来ず、ダメでした。

どなたかお知恵をお貸しください。

回答No.9

ushi2015

こんにちは
コードの真ん中下辺りの
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy x.Worksheets(1).Range("A1")
Application.DisplayAlerts = False
の間に、
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy x.Worksheets
x.Worksheets(1).Range("P:P").EntireColumn.AutoFit ’このコードを追加
Application.DisplayAlerts = False
と入れてみて下さい。

補足

ushi2015様

間が空いてしまい申し訳ございません。

月末・月初でバタバタしていました。

本日やっとご教示いただいたコードを追加してみたのですが、
結論から申し上げますと上手く行きませんでした。

まず、「間に・・・入れてみて下さい」の内容について確認をしたいのですが、

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy x.Worksheets(1).Range("A1")
x.Worksheets(1).Range("P:P").EntireColumn.AutoFit ’このコードを追加
Application.DisplayAlerts = False

↑で合っていますでしょうか？

これで実行しても、以前と同じように元表A'（90・97を省いたデータ）は
P列のJANコードが壊れてしまいます。

これは、csvデータを（「データ」→「テキストファイル」からインポートせずに）
そのままExcelで開いてしまった場合と同じ現象だと思います。

因みに今回気づいたのですが、P列の書式が「指数」になっています。

正常な方の別表BのP列は「標準」になっています。

何とかなりそうでしょうか…

私も忙しいため、遅くなっても構いませんのでお返事をお待ちしています。

よろしくお願いいたします。

回答No.7

ushi2015

こんにちは
先に回答した通りマクロブックには何も起きません。
名前を付けて元表Aと同じ場所に別のブックを作成しています。
確認して下さい。

補足

ushi2015さん

ありがとうございます！！

申し訳ございません。
私が見落としていました。

確かに、元表Aがあるフォルダに別表B（M列が90と97の物）が
出来ていました。
（以前私が「90」と「95」と書きましたが、それは私の間違いで、
　「90」と「97」だったので、そこは自分で直しました）

そして元表Aからは「90」と「97」のデータがちゃんと消えていました。
素晴らしいです！！
ありがとうございます。

が、１点だけ問題がありました。

処理前の元表AのP列はJANコード（13桁の数字）で、

4.56223E+12

というような表示になっています。

が、VBAを実行した後の表A（「90」と「97」が除かれた物）は、P列が

4.56E+12

と、何故か短くなっています。
（別表Bは、ちゃんと元の「4.56223E+12」表示になっています）

そのため、その後の処理でP列のJANコードをちゃんとした13桁の表示
（例：4562234567890)に直す際に、「4562230000000」のような間違った
数値になってしまいます。

そこが直れば完璧です。

何度も申し訳ございませんが、ご検証をお願い申し上げます。

よろしくお願いいたします。

回答No.6

kagakusuki

>あと、この場をお借りして申し訳ありませんが、「kagakusuki」様
>もし、これを読まれていたら、先ほどの私の補足に何か返信していただけませんか？
>「更に補足」ということが出来ないため、私からコメントすることが出来ない状態になってしまいました。

　本来の使い方ではないかも知れませんが、その様な場合にはお礼欄に書き込む事は出来なかったのでしょうか？
　今回、回答No.3様の御回答に対する補足コメントを目にする事が出来たのは本当に偶然で、普段の私はこのサイトのページの右上の方に表示されている[お知らせ通知]の件数を見て補足やお礼の有無を判断しているため、他の回答者の方のコメントのところに連絡を入れられても気づかない恐れが非常に高いです。

【参考URL】
　OKWAVE はじめてガイド マイページ（お知らせ機能について）
　　http://guide.okwave.jp/mypage/notification/

回答No.5

ushi2015

こんにちは
個人用マクロブックではなくて、新規ブックでいいです。
新規ブックを開いて、AltキーとF11キーを同時に押してVBEの画面を開き
メニューバーの挿入で「標準モジュール」を挿入し、前記したコードを
コピーして貼り付けます。
実行はシート画面でリボンの開発タブでマクロボタンから行います。

補足

月末で業務が忙しく、なかなかお返事が出来ず申し訳ございません。

新規ブックからの実行は既に試しました。

このページの一番下の私の補足コメント（2016-10-20 12:09:31）を
見て頂けますでしょうか？

新規ブックで実行をすると、すぐに「ファイルを開く」画面が出て
来ます。

そこで元表Aを指定するのですが、その後何も起こりません。
（新規ブックは、開いた直後の白紙の状態のまま）

どこを改善したら良いでしょうか？

回答No.4

ushi2015

こんにちは
マクロはマクロ実行用のブックにセットしておいて実行します。
ファイル開くでCSVファイルを選択すると、CSVファイルは「91」「95」
を除いたデータに、「91」「95」のデータは新規ブックとしてCSVファイルと
同じ場所に作成されます。
新規ブックの名前は「test実行年月日時間.xlsx」です。
実行後のCSVファイルとCSVファイルの保存フォルダ内を確認して下さい。
処理自体を見るにはマクロコード内をクリックしてF8キーでステップ実行すればいいです。

補足

ありがとうございます。

「個人用マクロブック」を使ったことがなかったので、下記サイト

https://allabout.co.jp/gm/gc/297809/2/

を参考にして作ろうとしたのですが、「マクロの記録」から作る
やり方なので上手くできませんでした。

そこで、適当な操作を記録して、VBAの編集画面で教えて頂いたコードに
変更すれば良いと考え、そこまでは上手くできました。

が、編集したあとにExcelを閉じようとすると「保存しますか？」と出てきた
ので保存しようとしたところ「読み取り専用のため保存できません」と
出てきました。

C→user→AppDATA…と辿って行って開いたのですが、どうして読み取り専用
になったのかわかりません。

そもそも、そのような回りくどいやり方ではなく、もっとスマートなやり方
があるのではないか？と思いました。

素人のためご迷惑をおかけしますが、VBAをマクロブックに登録する簡単な
方法があれば教えていただければ幸いです。

（私の方でも、もう少しググってみます）

よろしくお願いいたします。

回答No.3

ushi2015

こんにちは
csvのデータ、表Aは閉じておいて、ファイル開くで選択して下さい。

補足

すみません。

先にも書きましたが、表Aは開かずに新規のファイルから
実行してみました。

すぐに「ファイルを開く」の画面が出て来るので、表Aを選択
しましたが、何事も起こらず新規ファイルがそのままの状態
になります。

何かやり方が間違っていますか？

Excelファイルを一切何も開いていない状態で、VBAを実行する
ことが出来るのでしょうか？

あと、この場をお借りして申し訳ありませんが、「kagakusuki」様

もし、これを読まれていたら、先ほどの私の補足に何か返信して
いただけませんか？

「更に補足」ということが出来ないため、私からコメントすることが
出来ない状態になってしまいました。

回答No.2

kagakusuki

>オートフィルを使って「M列」で条件を選択（複数）し

という事で、抜き出す対象となるM列の値が複数存在しているという事と、抜き出す対象となるM列の値が必ずしも「90」と「95」であるとは限らないと思われるため、抜き出す対象となるM列の値を選択するというところまでは、マクロを起動させる前に手動でオートフィルターを使って済ませておき、その後でマクロを使って選択された行のみを新規に作成した別のブックに転記するものとします。
　尚、csvのファイル自体にはVBA等のマクロを保存する事が出来ない様ですから、大元のcsvのファイルでマクロを使用するのではなく、大元のcsvのファイルをコピーして作成したxlsmファイルでマクロを使用するものとします。
　また、マクロを起動させる際には「表A」が存在しているシートをあらかじめ開いておくものとします。
　それから下記のVBAのマクロは、もし該当データが無い場合には、新規ブックを開くなどの処理は行わず、転記すべきデータが存在しない事を知らせるMsgboxが現れて、そのMsgboxを閉じるとそのままマクロが終了される様になっています。

Sub QNo9245201_条件に合う行だけを切り取り→別ブックに自動転記()

Const ReferenceColumn = "M" 'オートフィルターで値を選択する対象となる列
Const ItemRow = 1 '表の各列の項目名が入力されている行

Dim NewBook As Workbook, LastRow As Long, myRange As Range

LastRow = Range(ReferenceColumn & Rows.Count).End(xlUp).Row
If LastRow <= ItemRow Then
MsgBox "転記すべきデータが見当たりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

Set NewBook = Workbooks.Add
With ThisWorkbook.ActiveSheet
.Cells.SpecialCells(xlCellTypeVisible).Copy NewBook.ActiveSheet.Cells(1, 1)
Application.CutCopyMode = False
.Range(ItemRow + 1 & ":" & LastRow).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
.Cells.AutoFilter
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

補足

すみません。

画面を更新していなかったので、こちらのご回答を見落としていました。

後ほど試行させて頂きます。

業務のスキマで質問していますので、結果はまた明日の報告になる
かもしれませんが、よろしくお願いいたします。

回答No.1

ushi2015

こんにちは
該当データが無い場合は空のブックが出来ます。
Sub test()
　　Dim s As Variant
　　Dim t As Workbook
　　Dim x As Workbook
　　s = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , , , False)
　　If s = False Then Exit Sub
　　Application.ScreenUpdating = False
　　Set x = Workbooks.Add
　　Set t = Workbooks.Open(s)
　　With t.Worksheets(1)
　　　　.Rows("1:1").Insert Shift:=xlDown
　　　　.Range("A1") = "dummy1"
　　　　.Range("A1").AutoFill Destination:=.Range("A1:S1"), Type:=xlFillDefault
　　　　.Range("A1").AutoFilter
　　　　.Range("A1").CurrentRegion.AutoFilter Field:=13, Criteria1:="=90", _
　　　　　　Operator:=xlOr, Criteria2:="=95"
　　　　.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy x.Worksheets(1).Range("A1")
　　　　Application.DisplayAlerts = False
　　　　.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Delete
　　　　x.Worksheets(1).Rows(1).Delete
　　　　x.SaveAs t.Path & "\test" & Format(Now(), "yyyymmdd hhmmss") & ".xlsx"
　　　　x.Close
　　　　.Parent.Save
　　　　.Parent.Close
　　　　Application.DisplayAlerts = True
　　End With
　　Application.ScreenUpdating = True
End Sub

補足

早々にありがとうございます！

…が、すみません。
私がVBA詳しくないので教えて頂けますでしょうか。

ご教示いただいたコードを、元の表Aを開いた状態で実行したところ
「ファイルを開く」画面が出てきました。

既に開いている表Aは開けないので、全く新規のブックを開いて
実行し、「ファイルを開く」が出たところで表Aを選択して「開く」
を押しましたが、何事も起こりませんでした。

どうしたら良いでしょうか・・・

※VBAは、Alt+F11で画面を開いたあと、挿入→標準モジュールで登録してます。

※ちなみに表Aは、日々DLする新しいデータになるので、VBAはクイックアクセス
　ツールバーに登録するつもりです。