複数ファイルデータを1つに纏めるチェックボックス有

質問

• 複数ファイルデータを1つに纏める際、チェックボックスの値についても正常に出力するためのマクロのコードを教えてください。
• 入力ファイルのデータフォーマットは、各列に出力ファイルのタイトルがあり、8行目以降にデータがあります。数値形式でない記載もそのまま出力する必要があります。
• 出力ファイルの記載フォーマットは、A列に参加番号、B列からK列およびN列には入力ファイルのタイトルからデータを出力します。

回答No.6

HohoPapa

本番環境でなにやらエラーが起きたり
いつまでたっても終わらない、
といった症状があるようであれば、
後記手当を行うことで
マクロブック配置フォルダーに実行ログを出力できます。

マクロの実行中であっても
このログファイルを別な個所に複写し
メモ帳で開けば、どこまで進んでいるかを確認できます。

よかったら仕込んでみてください。

'//　以下をコード群の末尾に追記
Sub LogPut(MyText As String)
　Open ThisWorkbook.path & "\MyLog.txt" For Append As #1
　Print #1, Now & Chr(9) & MyText
　Close #1
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

　LogPut f.path　　　'この行を新たに追加
　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

　PutBook.Sheets("Sheet1").Range("B" & TLastRow & ":K" & TLastRow + FLastRow - 8).Value = _
　　GetSheet.Range("B8:K" & FLastRow).Value

　GetSheet.Range("N8:U" & FLastRow).Copy _
　　PutBook.Sheets("Sheet1").Range("N" & TLastRow & ":U" & TLastRow + FLastRow - 8)

　PutBook.Sheets("Sheet1").Range("A" & TLastRow & ":A" & TLastRow + FLastRow - 8).Value = _
　　Mid(f.Name, 7, 8)

　GetBook.Close

End Sub

お礼

引き続きお世話になっております。
お薦め下さいました、マクロを実行しました。
自宅PC上では、相変わらず、出力ファイル保存の画面が隠れてしまっているようで、出力ファイルの保存が出来ませんでした。
別のPCでは、出力ファイルの保存画面が見えましたので、保存しマクロは正常終了しました。
実行ログも確認する事が出来ました。
チェックボックスを吐き出さない出力ファイルの行数は1221行作成されており、入力ファイルも全て正常に読み込まれた事を確認しました。
マクロ稼働時間は約20分間でした。有難うございました。
出力ファイルは、マクロ稼働前に作成した方が良いのかなと思いました。マクロの修正が可能なようでしたら、
ご教示を頂けますと大変助かります。
入力ファイルも、指定したホルダーのみのデータだけ読み込む設定のコードのご教示をお願いいたします。
この2点を解決する事が出来れば問題無しになると思います。大変お手数でも、どうぞよろしくお願いいたします。

補足

大変お世話になっております。
続けてご教示を頂きまして、ありがとうございました。
VBAのｽｸﾘﾌﾟﾄでこんなきめ細かい事が出来てしまうのですね。
あれから、数回マクロを繰り返している内に、やっと気づいたのですが、マクロがフリーズしているのではなく、
入力ファイルの読み込みが全て完了後、出力ファイル名作成要求画面が、マクロを起動した画面の後ろに隠れてしまっている為のようです。マウスは正常に動いております。
これらを解決するには、出力ファイルの保存場所を、入力ファイルを読み込む前に指定すれば問題ないのかなとも思いました。マクロのコードの修正が可能でしたら、出力ファイル保存場所を指定してから、入力ファイルを読み込めるようにするコードをご教示頂けないでしょうか？
又は、もっと良い方法がありましたらご教示を頂けますと大変助かります。

それから、もう一点、ご教示を頂きたい事があります。
入力ファイルの読み込みですが、指定したホルダー内でのみ読み込むようにして、入力ファイル名のトップが『課題参加者』拡張子が『xlsx』のファイルのみを読み込む設定へのコードの修正をご教示頂けないでしょうか。
下記のコードは、指定したホルダーの更にその配下のホルダーのファイルも読み込むのだと思います。それを、指定したホルダー内だけのファイルを読み込むようにしたいのですが、どのようなコードにしら良いの分かりません。
getFilesRecursive (BaseDir)

本日、ご教示頂きました実行ログの出力方法をこれからｽｸﾘﾌﾟﾄを追加修正し、マクロを起動してみます。ありがとうございました。
マクロを起動中は、負荷がかかっているようで、タイミングによっては、入力ファイル読み込み途中で止まってしまう事が何度かありましたので、それらの確認には大変便利になるとおもいます。

チェックボックスはコードをコメントアウトして出力ファイルに吐き出さない事にしました。チェックボックスが入った出力ファイルは大変な負荷がかかって重たい物になりました。
大変お手数をお掛けしておりますが、VBAコードについて覚えるきっかけになっております。
マクロ実行後の結果は、再度ご報告させて頂きます。