【VBAマクロ初心者】Excel VBAで複数ファイルをマージする際にファイルがそれぞれヘッダーの項

【VBAマクロ初心者】Excel VBAで複数ファイルをマージする際にファイルがそれぞれヘッダーの項目が違い1つのファイルのヘッダーに合わせる為に不要な列を削除、足りない列には空白列を挿入したいのですが、後々ヘッダーの項目が変更になった際に削除する列や空白列を挿入する条件を変更できるようにしたいです。
また、マージ対象のフォルダやファイルの設定も可能にしてマージ後のファイル名も変更可能ですがデフォルトでは当日の日付(20191023.xls)にしたいですが、職場にマクロを組める人がいない状態です･･･【急いでいます】

質問者からの補足コメント

• ファイルのヘッダーは現在は49列項目があります。
  フォルダの中に5～7個のxls形式のファイルがあり、ファイル名は
  それぞれ
  台帳(*CT)B票データ.xls
  台帳(*QE)B票データ.xls
  台帳(*ST)B票データ.xls
  台帳(*IS)B票データ.xls
  台帳(*SST)B票データ.xls
  *には英数字が記載されています。
  
  今回はCTのヘッダーを基準に
  20191023.xls(ファイル名はマージ当日の日付をデフォルトに)のファイルを作成して同じフォルダに保存したいです。

    補足日時：2019/10/23 16:33

• 空白列の挿入や不要列の削除は以下のようにしていますが、この部分を可変で外部から設定できるようにしたいです。
  
  Sub test()
  Columns(11).Insert
  Columns(16).Insert
  Columns(18).Insert
  Columns(19).Insert
  Range("AY:CJ").Delete
  End Sub

    補足日時：2019/10/23 16:49

• 補足が多くてすみません
  フォルダの中にはマージしないフォルダも含まれているので
  イメージとしては
  ・マージ対象のフォルダ選択
  ・同フォルダ内にバックアップ用のフォルダをコピー
  ・マージ対象のフォルダを選択
  ・バックアップ用のフォルダ内にマージ用ファイルを保存
  ・バックアップ用のフォルダ内のファイルの不要列削除と足りない列は空白を挿入
  ・マージして最初のフォルダ内にマージした日付をファイル名として保存
  ・バックアップ用のフォルダを削除
  
  初心者の自分にはハードルが高くなかなか実装出来ません･･･
  どうか御教授お願いします。

    補足日時：2019/10/23 17:20

• ＞GooUserラックさん
  
  ①「バックアップ用のフォルダ」は作業用の仮のフォルダのことです。
  ②そのフォルダへのコピーもマクロで行いたいです。
  ③添付のような場合の結果は　基準にしたいヘッダーを上の「あ　いう　えお」にする場合は
  下の「か」の列は削除で「おあいえ」の列はそれぞれ上の「おあいえ」の列にマッピングしたいです。
  ちなみに1行目のヘッダー部分は全て埋まっている状態です。
  ④各ファイルはシートが1枚だけです。
  ⑤1つのファイルはデータのある列は全て同じ行まで埋まっています。
  ⑥ヘッダーは全てあるのですが中身が（2行目から下）空欄の列もあります。また基準にするCTのファイルよりもヘッダーが多いものもあります。その場合は多い分の列を削除したいです。またヘッダーの項目は一緒でもヘッダーの列がずれている場合があります。その場合は列を入れ替えるかマッピングして入力したいです。

  
    補足日時：2019/10/23 23:57

• ＞GooUserラックさん
  ①②マージ元となるファイルは「20191023」「20191024」とフォルダを毎日作って手作業でxls形式のファイルを手作業で入れています。このフォルダの中に保管フォルダとマクロ付ファイルを置きたいです。③ここは手動でも大丈夫です。
  ④⑤⑥依頼者（マクロは組めない）からは「基準にするヘッダーだけのマージ用のファイル（今回はCTのファイルをコピーしてのヘッダー以外の行を削除したもの）を作って、そこにマッピングする動きをファイル数分繰り返したら出来るんじゃないの？先に要らない列を削除してもいいしマージしてから削除してもいいし、ただし後々項目も変わるかもしれないから外部から可変出来る様にして欲しい」という　分かるような分からないような感じの動きで作ってほしいそうです。
  ⑦⑧　①②のファイルとマージ後のファイルだけを「20191023」に残して作業用は削除したいです。

  
    補足日時：2019/10/24 00:33

No.9 回答者： GooUserラック 回答日時： 2019/10/25 14:23

事前削除ワードが決まっているなら「削除ワード.txt」を同じフォルダに置いておけば自動で処理出来ます。

結果を見て削除ワードが決まるならエクセルの機能を使って「検索」「行削除」を使った方が良いと思います。
いかがでしょうか？ご意見を提示して下さい。

この回答へのお礼

削除ワード.txtであれば後々
変更も楽ですね
それでお願いしたいです。
ちなみに削除ワードが含まれる行全てを削除なのですが大丈夫でしょうか？

あと先程変更した
2行の後に実行したら出たエラーについてはどのように対処したらよいでしょうか？
よろしくお願いします。

お礼日時：2019/10/25 14:30

No.8 回答者： GooUserラック 回答日時： 2019/10/25 13:31

・ 期限月曜日の件、一応了解しました（大きな問題が生じなければ可能だと思います）

・「不要行を削除する」の作業をしたいのならば、名前を付けて保存した後に閉じずにそのまま表示したままにすればボタンも不要だと思います。いかがでしょうか？

この回答へのお礼

不要行(〇〇が含まれている行)を削除する項目が可変の為
どこかのセルで指定してボタンを押して削除みたいなイメージだと
ありがたいのですが、素人なので何か良い案があればお願いします

お礼日時：2019/10/25 14:01

No.7 回答者： GooUserラック 回答日時： 2019/10/25 13:16

どんな風に改良予定かというと

① 作業ホルダーを図のようにリネームして１週間のみ残す。
　（ファイルコピーのつもりがファイル移動だった場合の救済）
② ドラッグ＆ドロップ時のメッセージを閉じるとそのまま連続で処理が出来る。
　（いちいち「マージ実行」のマクロを呼び出す必要が無い）

今日中に「進めて良い」とのご返事がいただければ進めます。

この回答へのお礼

確かにファイルをコピーして
マクロを実行よりは良いと思います。お願いします。

マクロを埋め込んだボタンを作ってクリックして実行するようにしてましたが、他にもマージ後に不要行を削除するマクロを追加しようとしていたところでしたが、ボタンは扶養行削除の分だけでいいと思います。

お礼日時：2019/10/25 13:20

No.6 回答者： GooUserラック 回答日時： 2019/10/25 12:55

参照設定については以下のようにすれば回避出来ます。

「Dim Obj_フォルダ As New FileSystemObject」
を次の２行に
「Dim Obj_フォルダ As Object」
「Set Obj_フォルダ = CreateObject("Scripting.FileSystemObject")」

「Dim Dic_ヘッダー As New Dictionary」
を次の２行に
「Dim Dic_ヘッダー As Object」
「Set Dic_ヘッダー = CreateObject("Scripting.Dictionary")」

ただ、もしもう少し時間がいただけるならば、もう少し直してみたいのですが…

この回答へのお礼

早速の回答ありがとうございます。
それぞれ2行ずつ書き換えました。

すると実行時エラーのオブジェクトが必要です。
と表示され
デバックしてみたら
Workbook.Open Filename:=ThisWorkbook.Path &"￥基本ヘッダー.xls"

が網掛けされました。
ファイルの中にはマージのマクロと基本ヘッダー.xlsのみ入っています。

最悪月曜日までに完成させなければいけないと
期限を設定されました。

お礼日時：2019/10/25 13:14

No.5 回答者： GooUserラック 回答日時： 2019/10/25 05:18

字数オーバーの為　その①

☆ 使用方法

① 空のフォルダを作り、そこにこのマクロ入りのファイルを保存して閉じます。
② そこに「基本ヘッダー.xls」を作り保存して閉じます。
③ このマクロ入りの開くと、必要な下位フォルダ自動で作成し、「作業」ホルダーを開きます。
④ この「作業」ホルダーにマージしたいファイルをドラッグ＆ドロップして下さい。
⑤ 終了したら、開いているエクスプローラを閉じ、メッセージも閉じます。
⑥「マージ実行」マクロを実行して下さい。
⑦ マージされたファイルは「保管」⇒「yyyy」⇒「mm」⇒「yyyymmdd.xls」で保存されます。
⑧「作業」ホルダーは削除されます。

※ ①と②は初回だけ必要です
※「ファイル一覧」「作業」というシートは作らないで下さい。内部で勝手に作ったり削除したりします。
※「基本ヘッダー.xls」ですが、１行目しか使いませんので「台帳(*CT)B票データ.xls」をただリネームした物でも構いません。（２行目以降に説明を書き込んでも構いません）
※「Microsoft Scripting Runtime」を参照設定して下さい。
　（「 http://itref.fc2web.com/vb/vba/dictionary.html 」に図入りで説明が有ります）
※ ホルダーの構造を図のように「基準」⇒「保管」⇒「yyyy」⇒「mm」⇒「yyyymmdd.xls」に変更しました。

☆「ThisWorkbook」へ

Private Sub Workbook_Open()

　Call フォルダ処理

End Sub

この回答へのお礼

とても分かりやすい
というか完成系を作って頂きありがとうございます。

自分のPCでは正しく動作を確認できたのですが
会社の開発用PCでは
VBAのマクロのツールの参照設定が変更出来ず動かすことができません･･･対処法を調べてみたのですがアクセス権限の付与が出来ませんでした･･･
https://qiita.com/sheep_LE/items/8eb1a59437817c2 …


参照設定を使わずに
セルにフルパスを入れてフォルダやファイルを指定する等出来ますでしょうか？

ここまで完璧なコードを作ってもらっておいて図々しいのは承知ですが
もし可能であれば御教授お願いします。大変申し訳ございません。

お礼日時：2019/10/25 12:37

No.4 回答者： GooUserラック 回答日時： 2019/10/25 05:17

字数オーバーの為　その②

☆「標準モジュール」へ

Public Day_今日 As Date

Sub フォルダ処理(Optional Day_今 As Date = #1/1/1900#)

Dim Str_パス As String
Dim Obj_シート As Object

　Application.DisplayAlerts = False
　For Each Obj_シート In Sheets
　　If Obj_シート.Name = "作業" Then Obj_シート.Delete
　Next
　For Each Obj_シート In Sheets
　　If Obj_シート.Name = "ファイル一覧" Then Obj_シート.Delete
　Next
　Application.DisplayAlerts = True
　
　If Day_今 = #1/1/1900# Then Day_今 = Now
　Day_今日 = Day_今
　Str_パス = ThisWorkbook.Path & "\" & "保管"
　If Dir(Str_パス, vbDirectory) = "" Then MkDir (Str_パス)
　Str_パス = Str_パス & "\" & Format(Day_今, "yyyy")
　If Dir(Str_パス, vbDirectory) = "" Then MkDir (Str_パス)
　Str_パス = Str_パス & "\" & Format(Day_今, "mm")
　If Dir(Str_パス, vbDirectory) = "" Then MkDir (Str_パス)
　Str_パス = ThisWorkbook.Path & "\" & "作業"
　If Dir(Str_パス, vbDirectory) = "" Then MkDir (Str_パス)
　Shell "C:\Windows\Explorer.exe " & Str_パス, vbNormalFocus
　MsgBox ("マージしたいファイルをドラッグ＆ドロップして下さい。" & Chr(13) & _
　　　　　"（注意：ドロップするときは必ず[Ctrl]キーを押しながら行ってください。）" & Chr(13) & _
　　　　　"・このメッセージが開いている間でもドラッグ＆ドロップは可能です。" & Chr(13) & _
　　　　　"・ドラッグ＆ドロップが終わったら必ずエクスプローラを閉じて下さい")

End Sub

Sub マージ実行()

Dim Dic_ヘッダー As New Dictionary
Dim Lng_元番号 As Long
Dim Lng_列番号 As Long
Dim Str_ファイル名 As String
Dim Lng_対象数 As Long
Dim Obj_シート As Object
Dim Str_作業パス As String
Dim Lng_行番号 As Long
Dim Lng_終番号 As Long
Dim Lng_次番号 As Long
Dim Lng_辞書位置 As Long
Dim Lng_最大行 As Long

Dim Obj_フォルダ As New FileSystemObject
　If Dir(ThisWorkbook.Path & "\基本ヘッダー.xls") = "" Then
　　MsgBox ("「" & ThisWorkbook.Path & "」に「基本ヘッダー.xls」が有りません。作成してやり直してください")
　　Exit Sub
　End If
　Workbooks.Open Filename:=ThisWorkbook.Path & "\基本ヘッダー.xls"
　For Lng_列番号 = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
　　Dic_ヘッダー.Add Cells(1, Lng_列番号).Value, Lng_列番号
　Next
　Windows("基本ヘッダー.xls").Close
　Application.DisplayAlerts = False
　For Each Obj_シート In Sheets
　　If Obj_シート.Name = "作業" Then Obj_シート.Delete
　Next
　For Each Obj_シート In Sheets
　　If Obj_シート.Name = "ファイル一覧" Then Obj_シート.Delete
　Next
　Application.DisplayAlerts = True
　Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ファイル一覧"
　Range("A1").Value = "マージファイル一覧"
　
　Str_作業パス = ThisWorkbook.Path & "\作業\"
　Str_ファイル名 = Dir(Str_作業パス & "*.xls")
　Lng_行番号 = 1
　Do While Str_ファイル名 <> ""
　　Lng_行番号 = Lng_行番号 + 1
　　Cells(Lng_行番号, 1) = Str_ファイル名
　　Str_ファイル名 = Dir()
　Loop
　Columns("A:A").Columns.AutoFit
　Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "作業"
　For Lng_辞書位置 = 0 To Dic_ヘッダー.Count - 1
　　Cells(1, Dic_ヘッダー.Items(Lng_辞書位置)).Value = Dic_ヘッダー.Keys(Lng_辞書位置)
　Next
　Lng_次番号 = 2
　For Lng_行番号 = 2 To Sheets("ファイル一覧").Cells(Rows.Count, 1).End(xlUp).Row
　　Str_ファイル名 = Sheets("ファイル一覧").Cells(Lng_行番号, 1).Value
　　Workbooks.Open Filename:=Str_作業パス & Str_ファイル名
　　ActiveSheet.Move After:=ThisWorkbook.Sheets(Worksheets.Count)
　　Lng_最大行 = 0
　　For Lng_列番号 = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
　　　If Dic_ヘッダー.Item(Cells(1, Lng_列番号).Value) <> "" Then
　　　　Lng_終番号 = Cells(Rows.Count, Lng_列番号).End(xlUp).Row
　　　　If Lng_最大行 < Lng_終番号 Then Lng_最大行 = Lng_終番号
　　　End If
　　Next
　　For Lng_列番号 = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
　　　Lng_元番号 = Dic_ヘッダー.Item(Cells(1, Lng_列番号).Value)
　　　If Lng_元番号 <> 0 Then
　　　　Range(Cells(2, Lng_列番号), Cells(Lng_最大行, Lng_列番号)).Copy Sheets("作業").Cells(Lng_次番号, Lng_元番号)
　　　End If
　　Next
　　Application.DisplayAlerts = False
　　　ActiveWindow.SelectedSheets.Delete
　　Application.DisplayAlerts = True
　　Lng_次番号 = Lng_次番号 + Lng_最大行 - 1
　Next
　Sheets("作業").Move
　Str_ファイル名 = ThisWorkbook.Path & "\保管\" & _
　　Format(Day_今日, "yyyy") & "\" & _
　　Format(Day_今日, "mm") & "\" & _
　　Format(Day_今日, "yyyymmdd") & ".xls"
　ActiveWorkbook.SaveAs Filename:=Str_ファイル名
　ActiveWindow.Close
　Application.DisplayAlerts = False
　Obj_フォルダ.DeleteFolder ThisWorkbook.Path & "\作業"
　Application.DisplayAlerts = True
　Set Dic_ヘッダー = Nothing
　Set Obj_フォルダ = Nothing

End Sub

No.3 回答者： GooUserラック 回答日時： 2019/10/24 01:24

毎日フォルダを作っていったら探すのが大変です。

図のように基準フォルダに、このマクロ付ファイルを置いておき、このファイルを開くと自動で「年」「月」「日」フォルダを無かったときは作成し、その下に「保存」と「作業」フォルダを作成し、当日のフォルダーを開く（ここまで自動）はいかがでしょうか？
その後、手作業でxls形式のファイルを入れれば良い気がします。いかがでしょうか？

この回答へのお礼

とても素晴らしいと思います。まだVBAを最近勉強し始めたばかりなのに、依頼者からはかなりハードルを上げられて困っている状態でボタン１つで完結させてとか無茶振りが激しいので(^_^;)
VBAの逆引きの本とかも買ってみたのですがいきなり複数ファイルやフォルダを使ってマージや削除やら条件が多いと
なにから始めていいかも分からなくなってしますね(^_^;)

最初はマクロの記録でいけそうな気がしたのですが、マージ元となるファイルは行数も項目も変わっていくらしいので無理みたいです。VBAに慣れるにはやはり作って慣れていくしかないとは思いますが、まだまだ道のりは長そうです・・・

依頼者からはマクロを実行したときにマージ対象のフォルダ選択とマージ対象のフォルダ（複数）を参照で選択出来る様にしてマージ後のファイル名の変更は可能（ただし1－台帳(2019MMDDマージ)B票データ.xlsはデフォルト）QEやSTなどのファイルはCTとヘッダーの数や並びが一部異なるので項目位置を合わせて　多い分は削除でない部分は空白設定をするという条件を外から設定可能
つまりあらかじめ設定してからマクロを実行できるようにして　基準がCT以外にQEやSTのヘッダーに合わせる場合に応用がきくようにしてほしいとのことです。かなり注文が多くて本当に実装できるのかすら怪しくなってきました。しかも今回基準となるCTの抽出条件として不要な行があり、そこは削除しなければいけないそうです。なのでマージする前にCTの不要な行をあらかじめ削除しておかないといけないらしいです。

お礼日時：2019/10/24 01:55

No.2 回答者： GooUserラック 回答日時： 2019/10/23 22:45

こんな感じの動きで良いのでしょうか？

① 専用のフォルダを作り、このマクロ付のファイルのみを置く
② 同じフォルダの中に保管フォルダを作成する
③ マージしたいファイルを専用のフォルダに手動でコピーする。
　（専用のフォルダには保管フォルダとマージしたいファイルとマクロ付のファイルのみにする）
④ ヘッダーだけを集めるマクロを実行して、このマクロ付のファイルに重複の無いヘッダーだけのシートを作る。
⑤ 手動でヘッダーの順番を入れ替える
⑥ マージするマクロを実行してすべてのファイルをマージする。
⑦ 作ったシートをコピーして単独のファイルにして保管フォルダに名前を付けて移動する
⑧ 専用フォルダ内のこのマクロ付のファイル以外のファイルは全て削除する

※ ①②は初回のみ
※ ⑥～⑧は自動で連続して行われる

No.1 回答者： GooUserラック 回答日時： 2019/10/23 22:15

①「バックアップ用のフォルダ」とは、作業用の仮のフォルダですよね。

② そのフォルダーへのコピーは手作業でいいのですか？もし手作業ならば別ドライブへのコピーがお勧めです。同じドライブだと基本が移動になってしまうのでミスが起こりやすいです。
③ 添付のような場合は結果はどうしたいのでしょうか？
④ 各ファイルはシートが１枚だけという事でしょうか？
⑤ １つのファイルはデータのある列は全て同じ行まで埋まっていますか？
⑥ ヘッダーの無い列は空として考えて良いのですか？