いつもこちらでお世話になっております。
先日も同じような質問をさせて頂いたのですが、
ファイルの構成が変わってきてしまい、再度質問させて頂きます。
(元データ)
A B C D E
No 月1 月2 月2 氏名
1 2010/11 2010/8 2010/7 佐藤
2 2010/10 2010/8 2010/7 山田
3 2011/12 2010/8 2010/7 田中
4 2010/10 2010/8 2010/7 田中
・
・
上記のデータが1年度あたり
ファイル1(4シート+一覧シート)
ファイル2(4シート+一覧シート)
ファイル3(4シート+一覧シート)
ファイル4(4シート+一覧シート)
ファイル5(4シート+一覧シート)
※上記A列のNoは1シート内での連番。
のように構成され、それが6年度分(計30ファイル)あるという状態です。
別ファイルにて2010/10とセルに入力してやると、各ファイルのB~D列に2010/10
とあるデータだけ抽出して一覧にしてくれるようにしたいと考えております。
関数またはVBAにて処理する方法はありますでしょうか?
お知恵を拝借願えれば幸いです。
No.3ベストアンサー
- 回答日時:
ここがデバッグで黄色になったのであれば、対象ファイルのなかにE列以降にまったくデータのないシートがあるということですね。
そういうシートもあるのなら、手当てをしておけばすみます。
で、当初のB:D列ではなく、本当はE:G列を検索するのですね?
そのように直しました。
Sub test02()
Dim wb(1) As Workbook '変数宣言
Dim ws(2) As Worksheet
Dim myFl As String, MyPt As String
Dim myTg
Dim i As Long
Dim myC As Range
Set wb(0) = ThisWorkbook
Set ws(0) = wb(0).Sheets("Sheet1")
Set ws(1) = Sheets.Add(after:=Sheets(wb(0).Sheets.Count)) 'シート追加
MyPt = wb(0).Path & "\" '自分のパスを取得
myFl = Dir(MyPt & "*.xls", vbNormal) 'パス内のエクセルファイル
Application.ScreenUpdating = False '画面更新停止
myTg = ws(0).Range("A1").Value '検索年月
Do While myFl <> "" 'エクセルBOOKがなくなるまで
If myFl <> wb(0).Name Then '自分以外のファイルを対象
Set wb(1) = Workbooks.Open(MyPt & myFl) '選択したBOOKを開く
For Each ws(2) In wb(1).Worksheets '開いたBOOKの各シート
With ws(2)
If .UsedRange.Cells(.UsedRange.Count).Column > 4 Then 'E列以降にデータがあれば
For Each myC In Intersect(.Range("E:G"), .UsedRange) 'E:G列
If myC.Value = myTg Then '検索年月があったら
i = i + 1 'カウント
myC.EntireRow.Copy ws(1).Rows(i) 'その行を追加したシートにコピペ
End If
Next myC
End If
End With
Next ws(2)
wb(1).Close (False) '選択したファイルを閉じる
End If
myFl = Dir() '次のファイルを検索
Loop '繰り返し
Application.ScreenUpdating = True '画面更新停止解除
End Sub
No.2
- 回答日時:
すみません、ミスタイプです。
VBAコード、11行目
(誤) MyPth = wb(0).Path & "\" '自分のパスを取得
(正) MyPt = wb(0).Path & "\" '自分のパスを取得
訂正します。
お礼が遅くなってしまい申し訳ありませんでした。
教えて頂いたVBAを本ファイルに適用してみたのですが、
実行すると「オブジェクトが必要です」と出てしまい、
For Each myC In Intersect(.Range("E:G"), .UsedRange) 'E:G列
この行が黄色くなってしまいます。
※本ファイルに適用するために列名を変えております。
マクロはかなり初心者で、色々と調べてみたのですが
どこを直せば解消されるのかがわかりませんでした。
原因等、思い当たることがありましたらお教え願えれば幸いです。
No.1
- 回答日時:
> 先日も同じような質問をさせて頂いたのですが、
その質問が今回の質問への回答上、参考にしたほうが良いのなら、その質問にリンクさせるなり、すくなくとも質問番号くらいは書いた方がいいです。
わたしはその質問を探せませんでしたので今回の質問にのみ対応しました。
> 別ファイルにて2010/10とセルに入力してやると、
これも曖昧です。
別ファイルとは、マクロを書いたBOOKという理解でよいですか?
わからないのでその前提でいきます。
その別ファイルのどこに2010/10が入力してあるのですか?
これもわからないのでSheet1のA1セルに入力されたものとします。
それから2010/10とセルに入力したら、文字列ではない限り2010/10/1とか、Oct-10とかの表示に化けるのではないですか?
日付として入力されたものが書式による表示で2010/10としてあるのですか?
> データだけ抽出して一覧にしてくれるようにしたい
どこに抽出するのですか?
不明な点ばかりですが、マクロを書いた別ファイルにあらたにシートを追加して、そこに抽出させるようにしてみました。
その30件くらいの検索対象のBOOKが入っているフォルダーに以下のマクロを書いたエクセルBOOK(転記先となる別ファイル)を保存してください。(パス取得のため、必ず「保存」が必要です。)
そのフォルダー内には検索対象のBOOKと、このマクロを書いたBOOKしかないものとします。
以下は標準モジュールに記述してください。
Sub test01()
Dim wb(1) As Workbook '変数宣言
Dim ws(2) As Worksheet
Dim myFl As String, MyPt As String
Dim myTg
Dim i As Long
Dim myC As Range
Set wb(0) = ThisWorkbook
Set ws(0) = wb(0).Sheets("Sheet1")
Set ws(1) = Sheets.Add(after:=Sheets(wb(0).Sheets.Count)) 'シート追加
MyPth = wb(0).Path & "\" '自分のパスを取得
myFl = Dir(MyPt & "*.xls", vbNormal) 'パス内のエクセルファイル
Application.ScreenUpdating = False '画面更新停止
myTg = ws(0).Range("A1").Value '検索年月
Do While myFl <> "" 'エクセルBOOKがなくなるまで
If myFl <> wb(0).Name Then '自分以外のファイルを対象
Set wb(1) = Workbooks.Open(MyPt & myFl) '選択したBOOKを開く
For Each ws(2) In wb(1).Worksheets '開いたBOOKの各シート
With ws(2)
For Each myC In Intersect(.Range("B:D"), .UsedRange) 'B:D列
If myC.Value = myTg Then '検索年月があったら
i = i + 1 'カウント
myC.EntireRow.Copy ws(1).Rows(i) 'その行を追加したシートにコピペ
End If
Next myC
End With
Next ws(2)
wb(1).Close (False) '選択したファイルを閉じる
End If
myFl = Dir() '次のファイルを検索
Loop '繰り返し
Application.ScreenUpdating = True '画面更新停止解除
End Sub
この回答への補足
回答ありがとうございました。
> 先日も同じような質問をさせて頂いたのですが・・
失礼致しました、先日の質問はこちらになります。
http://oshiete.goo.ne.jp/qa/6277479.html
> 別ファイルにて2010/10とセルに入力してやると、
その前提で問題ありません。
シリアル値をyyyy/mと書式設定しています。
> データだけ抽出して一覧にしてくれるようにしたい
抽出先は2010/10と入力した同一ファイル(同一シート、別シートの拘りはありません。)
となります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excel VBAどこが間違ってますか? 4 2023/07/17 10:04
- Excel(エクセル) Excelの関数でこんな処理ができますか 1 2023/02/08 13:46
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Excel(エクセル) マクロか関数で処理したいのですが、教えて頂けませんか。 8 2022/10/31 15:18
- Visual Basic(VBA) 複数ファイルのデータの統合について 12 2022/05/14 12:03
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/03/12 10:10
- Excel(エクセル) EXCEL マクロで 同じフォルダ内の複数ファイルの複数行全体を選択して1つのファイルに集約 4 2022/09/27 18:41
- Excel(エクセル) ワードのマクロについて教えてください。 1 2023/03/11 13:50
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) VBAの参照先のファイル名をセルに書いて代入したい 2 2022/04/04 13:42
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
Teraマクロで日付ディレクトリ...
-
PDF ファイルが開けません。
-
EXCELのマクロを使って、テキス...
-
EXCELのVBAで画像を選んだ順に...
-
ハイパーリンクで前回値をひき...
-
EXCELで複数のファイルから抽出
-
複数のExcelブックから一覧表を...
-
エクセル 一括リンクの解除
-
excel INDIRECT 他ファイル参照
-
パス名を参照するコードのファ...
-
=CELL("filename")で取得したフ...
-
指定のファイルを開くマクロ
-
ミュージックファイルのファイ...
-
ローマ字→カタカナへ変換(エク...
-
コマンドボタンを押すたびに大...
-
マクロ 実行ボタンを押さずに...
-
Excel:コマンドボタンの移動
-
ワードで画像を自動で挿入する方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
EXCELのVBAで画像を選んだ順に...
-
Teraマクロで日付ディレクトリ...
-
ファイルを並び替えるときの「...
-
VLOOKUP関数とネットワークに置...
-
エクセル 一括リンクの解除
-
excel INDIRECT 他ファイル参照
-
エクセルファイルから指定した...
-
エディタで効率的な切り出し方法
-
PDF ファイルが開けません。
-
EXCELのマクロを使って、テキス...
-
ハイパーリンクで前回値をひき...
-
エクセルからスキャナVBAで連動...
-
EXCEL VBA ー 同一フォルダ内の...
-
CSVで文字化けしてしまうのを直...
-
エクセルマクロでファイルオー...
-
ミュージックファイルのファイ...
-
エクセルVBAでファイルを連...
-
エクセルVBA+ADOで特定のCSVフ...
おすすめ情報