- ベストアンサー
複数ファイルのデータを1つのファイルへ纏めるマクロ
- VBAの初心者で、ｽｸﾘﾌﾟﾄの書き方が分からずマクロが作成できないと困っています。Excel形式の約400個のファイル中のデータを１つの出力ファイルへ纏めるマクロを作成したいです。
- 入力ファイルの中身は頻繁に追加、削除を繰り返しているため、手動で入力ファイルと出力ファイルを修正するのが面倒です。マクロの実行で自動的にデータを纏めたいです。
- 出力ファイルには入力ファイルのB列～K列とN列のデータを吐き出し、A列には入力ファイル名の『23RF3001』、『23RF3543』などを入れたいです。また、出力データの範囲は『職員番号』、『名前』、『部門』に記載がある行のみとし、書式フォーマットも指定したいです。
- nnirosan
- お礼率34% (82/235)
- Visual Basic
- 回答数5
- ありがとう数5
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (4)
- HohoPapa
- ベストアンサー率65% (455/693)
>・出力ファイルの『A列:$1』には『ファイル名(hgehogeID)』の記載はありますが、 >2行以降は空白のままとなっています。 これは、コードを書き漏れていました。直しました。 チェックボックスは要求通りに複写したつもりです。 オン、オフが期待通りかどうかは別にして、 期待通り複写されていませんでしょうか？ オン、オフが期待通りかどうかは 先に説明しました、 >チェックボックスに、リンク先セルの設定はないことが前提です この前提を満たしていない可能性を疑います。 転記元のシートの適当なチェックボックスを右クリックし コントロールの書式設定を選択し、添付画像個所を確認してください。 このが空欄であれば正しく複写できるはずです。 ここにセルのアドレスが埋まっているようなら、 チェックボックスの配置セルとリンクするセルの関係を明らかにしてください。 （同じセルとか、1行したとか、右側のセルといった関係です） >・出力ファイルはM列が有り、全て空欄でした。 ？？そもそもＬ，Ｍ列は転記対象ではないものと判断しました。 先のスレッドで伝えた >入力側のシートサンプル、 >出力側シートサンプルを画像付きで説明してくれないと >理解できません。 このうち、 出力側シートサンプルの提示が無いので、期待されていることが 当方に伝わらないのではないかと思います。 再び、このスレッドは閉じ、 もう1度、新たにスレッドを起こしたほうがいいと思います。 Option Explicit '以下を参照設定 'Microsoft Scripting Runtime Const tgSheet = "Participant List" '入力側シート名 Const A_Title = "ファイル名(hgehogeID)" Dim BaseDir As String Dim HitFileCount As Long Dim PutBook As Workbook Dim RowCount As Long Sub sample() Dim PutPass As String '元データ格納フォルダーを取得 With Application.FileDialog(msoFileDialogFolderPicker) .Show BaseDir = .SelectedItems(1) End With '保存先ブックを新規オープン Set PutBook = Workbooks.Add 'メイン処理をコール HitFileCount = 0 getFilesRecursive (BaseDir) '保存先のフルパスを取得して保存し、クローズ With Application.FileDialog(msoFileDialogSaveAs) .Show PutPass = .SelectedItems(1) PutBook.SaveAs (PutPass) PutBook.Close End With MsgBox Format(HitFileCount, "0") & "件のファイル処理終了" End Sub 'フォルダー、ファイルを総当たり Sub getFilesRecursive(path As String) Dim FSO As FileSystemObject: Set FSO = New FileSystemObject Dim objFolder As folder Dim objFile As file 'フォルダーを個々に取得 For Each objFolder In FSO.GetFolder(path).SubFolders getFilesRecursive objFolder.path Next 'ファイルを個々に取得 For Each objFile In FSO.GetFolder(path).Files If UCase(FSO.GetExtensionName(objFile.path)) = "XLSX" Then execute objFile End If Next End Sub '取得したファイルのデータを取得して格納する Sub execute(f As file) Dim GetBook As Workbook Dim GetSheet As Worksheet Dim FLastRow As Long Dim TLastRow As Long Dim r As Long '対象のファイルを数える HitFileCount = HitFileCount + 1 'ファイルを開いてシートを取得 Set GetBook = Workbooks.Open(f.path) Set GetSheet = GetBook.Sheets(tgSheet) If HitFileCount = 1 Then PutBook.Sheets("Sheet1").Range("B1:E1").Value = _ GetSheet.Range("B6:E6").Value PutBook.Sheets("Sheet1").Range("F1").Value = _ GetSheet.Range("F5").Value PutBook.Sheets("Sheet1").Range("G1:H1").Value = _ GetSheet.Range("G6:H6").Value PutBook.Sheets("Sheet1").Range("I1:K1").Value = _ GetSheet.Range("I7:K7").Value PutBook.Sheets("Sheet1").Range("N1").Value = _ GetSheet.Range("N6").Value PutBook.Sheets("Sheet1").Range("A1").Value = A_Title RowCount = 2 End If '最終行を取得して、対象範囲を複写 FLastRow = GetSheet.Cells(Rows.Count, "B").End(xlUp).Row TLastRow = PutBook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row + 1 GetSheet.Range("B8:K" & FLastRow).Copy _ Destination:=PutBook.Sheets("Sheet1").Range("B" & TLastRow & ":K" & TLastRow + FLastRow - 8) GetSheet.Range("N8:N" & FLastRow).Copy _ Destination:=PutBook.Sheets("Sheet1").Range("N" & TLastRow & ":N" & TLastRow + FLastRow - 8) PutBook.Sheets("Sheet1").Range("A" & TLastRow & ":A" & TLastRow + FLastRow - 8).Value = _ Mid(f.Name, 7, 8) '元ファイルクローズ GetBook.Close End Sub
お礼
早速のご教示ありがとうございました。 ・コードを書き漏れていました。直しました。 → 修正頂いたマクロを実行し、A列に値が正常に入りました。ありがとうございました。 ・チェックボックスに、リンク先セルの設定はないことが前提ですこの前提を満たしていない可能性を疑います。 → お察しの通り、表示範囲外(Q列、R列、S列、T列)には、『TRUE』、『FLASE』の文字が入っておりました。 全く気付いておらず、説明がなってなくて申し訳ありませんでした。 入力ファイル中のチェックボックスの[コントロールの書式設定]は以下の通りです。 I列＝値はオンにチェックがついており、[リンクするセル』＝『$Q$8』 J列＝値はオンにチェックがついており、[リンクするセル』＝『$R$8』 K列＝値はオンにチェックがついており、[リンクするセル』＝『$S$8』 M列＝値はオンにチェックがついており、[リンクするセル』＝『$T$8』 L列には以下の関数式が入っていました。 =IF(AND(S8=TRUE,OR(Q8=TRUE,R8=TRUE)),"","右欄も要確認") N列には以下の関数式が入っていました。 =IF(AND(S8=TRUE,OR(Q8=TRUE,R8=TRUE)),"合同設備等利用可能",IF(T8=TRUE,"合同設備等利用可能","内部運営管轄と相談下さい")) 以上の事から、ご指摘の通り、入力ファイルと出力ファイルの画面イメージを作成しまして、 再度のご質問をさせて頂きたいと思います。 単純にマクロ処理を考えておりました事、深く反省です。こんなに奥が深いとは思ってもいませんでした。 そして、ここまでマクロを作成下さいまして、感謝の限りです。 次の質問でも、お力添えを頂けましたら大変幸甚です。
- SI299792
- ベストアンサー率47% (801/1677)
この画像、行が出ていません。転記元、転記先共７行からとします。 チェックボックスのリンクするセルがどこか解りません。チェックボックスのあるセルと同じセルになっている前提です。 フォルダはこのマクロを入れたワークブックと同じフォルダとします。 １ブック１シートとします。 Option Explicit ' Sub Macro1() Dim O As Worksheet Dim FileName As String Dim REnd As Long ' Set O = ThisWorkbook.ActiveSheet FileName = Dir(ThisWorkbook.Path & "\課題参加者_*.xlsx") Range("B7:L" & Rows.Count).ClearContents ActiveSheet.CheckBoxes.Delete Application.ScreenUpdating = False ' Do While FileName > "" Workbooks.Open ThisWorkbook.Path & "\" & FileName, False, True REnd = Cells(Rows.Count, "B").End(xlUp).Row O.Rows("7:" & REnd).Insert Range("B7:K" & REnd).Copy O.[B7] Range("N7:N" & REnd).Copy O.[L7] Workbooks(FileName).Close False FileName = Dir Loop End Sub
お礼
マクロのコードのご教示、誠にありがとうございました。 入力ファイルにリンクの設定があるチェックボックスが 有りまして、その事に気付かず質問が口足らずでした。 再度、それらを含めた質問をさせて頂きます。
- imogasi
- ベストアンサー率27% (4737/17070)
何を聞いてもても良い質問コーナながら、これでは回答者側で、相当な長時間の労務の提供依頼になる見込。それをやってくれと言うのは、どうかな。常識では頼まないだろう。 その他に （１）状況や課題の説明が、数十行の、文字の文章では出来ないと思う。 業者が請け負うとしても、資料も見せてもらって、数時間のミーティングはするだろう。 頼む目的さえ質問に、説明されていないのでは。 （２）実際実行してテストすべきでしょうが、テストデータがない。回答者では作れない。 （３）ブックの数量（データ量）が多くて、ブックごとに細切れで、内容的に例外がないのかどうか。それらの諸々の理解が行き届くかどうか。 （４）質問の説明ぶりから、質問者は、多少でもシステムを経験した人とは思えない。 ですから、要望に応えるのは無理でしょう。 ーー 元々、エクセルで処理する類のものではないだろうと思う。 詳しくは判らないが、どうも人事のスキルやジョブ管理システムのように見える。 システム課題そのものはありふれた類型であるようだが。 そういう課題にふさわしいソフト（は相当あるはずでそれ）を、この際導入検討をしてはどうか。 異動の更新や、検索などにも特有のニーズがあるだろう。 データの移行切り替えが必要だが、それに適当な時期ではないか。 データベース的なものになるのではないかと思う。データを多くためておいて、目的に応じて検索し 目的表などを作成する。エクセルはその時期時期で、１枚のシートになりがち。エクセル以前から 一般に、システム部門ではそれは痛感されていた。素人がエクセルで何とかその場を切り抜けようとした結果が、今なにか、それでは限界に来たのではないか。 全般に、システムというモノを甘く見過ぎではないか。内容面も経済的コスト面でも、コストがかかるものだということも含めて。
お礼
ご教示ありがとうございました。 確かに、おっしゃる通りでございます。 VBAｽｸﾘﾌﾟﾄは大変奥が深いです。
補足
色々とご指摘を頂きましてありがとうございます。 先ずは、自分でVBAのスクリプトを組み合わせながら作成してみます。
- kon555
- ベストアンサー率51% (1849/3571)
残念ながらというか、書かれているようなシチュエーションで問題なく動作するマクロを、このようなQAサイト上のやり取りで作成するのは極めて困難です。 一方で、VBAの処理としてはそこまで高度というわけではなく、初心者レベルでもある程度時間をかければ作成は可能でしょう。 問題は条件が多く、また元々のレイアウトなどが自動処理に不向きな事なので、データさえあれば何とでもなります。 なので貴方自身がVBAのスキルを身につけて、作業を少しずつでも合理化していく事をオススメします。 ExcelVBAは参考になるサイトも多く、独学でも実務で使えるレベルにはなれます。またある程度まで貴方が組めれば、分からない所をこうしたサイトで質問する事も出来ます。 一応学習用のオススメサイトを紹介しておきます。 https://excel-ubara.com/excelvba1/ https://my-tax-nology.com/the-way-of-starting-excel-vba-anyway/amp
お礼
ご教示ありがとうございました。 説明に口足らずな所が有り、又リンクの設定があるチェクボックスの事に気付かず質問をしておりました。 再度、これらチェックボックスを含めた質問をさせて頂きます。
補足
引き続きVBAのｽｸﾘﾌﾟﾄをご教示頂き誠に有難うございました。 昨夜からずっと、前回ご教示頂いたｽｸﾘﾌﾟﾄを使って、色々と試していましたが、VBAの知識が全くゼロの為、無茶苦茶エラーが出まくって思うようにｽｸﾘﾌﾟﾄが動かず困っておりました 早速、作成頂きましたｽｸﾘﾌﾟﾄを実行させて頂きました。 ｽｸﾘﾌﾟﾄはエラー無しで起動し、全ての入力ファイルを読み込む事ができました。 出力ファイルを確認すると、下記のような結果になりましたので、ｽｸﾘﾌﾟﾄをいじって見ましたが、エラーが出るばかりで一向に解決する事が出来ませんでした。 大変お手数ですが、下記について解決出来る対処がありましたら、どうぞご教示をよろしくお願いします。 ・出力ファイルの『A列:$1』には『ファイル名(hgehogeID)』の記載はありますが、2行以降は空白のままとなっています。 → 前回のｽｸﾘﾌﾟﾄの下記を追加してみましたが、下記だけ追加したのでは、エラーが出てだめでした。 'ファイル名出力 TRng1 = "A" & Format(RowCount, "0") & ":A" & Format(RowCount + 42, "0") PutBook.Sheets("Sheet1").Range(TRng1).Value = Mid(f.Name, 7, 8) ・出力ファイルのI列～K列のチェックボックスとN列について、質問で添付させて頂きました図でご説明しますと、 B列～H列の値と同じ行数分、赤枠の下の行のチェックボックスが入っているようです。 K列のチェックボックスは大半はL列に入っています。 出力側の全てのチェックボックスは、チェックが付いてない状態です。 出力側のN列も上記と同じで、赤枠の下の行の値が入っています。 → チェックボックスを出力ファイルへ吐き出すのは、 色々と大変なように感じました。 何とか、N列の値だけでも吐き出したいのですが、 下の行を出力してしまう原因が全く分かりませんでした。入力ファイル側に原因が有るのか？ ・出力ファイルはM列が有り、全て空欄でした。 → こちらの列は、出力ファイル側のタイトルも空白でしたので、このままとします。