質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.35%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マージ

複数のデータベースやファイル、プログラムなどを決まった手順や規則に従って一つに結合すること。

Q&A

解決済

4回答

1323閲覧

VBA 2つのファイルのマージ

kitagawasho

総合スコア28

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マージ

複数のデータベースやファイル、プログラムなどを決まった手順や規則に従って一つに結合すること。

0グッド

1クリップ

投稿2020/02/20 09:35

前提・実現したいこと

業務で2つのPCでシミュレーションした結果をひとつにまとめるプログラムを作りたい。
現在、1つにまとめることはできていますが、2つ目のシートの目次のようなもの(x,y,zのような1つ目のシートで
記載されている部分がまた出てしまっています。)
VBAに詳しくなく、ソースコードを見ても、セルのどこから読み取るなど(A2セルみたいな感じ)の情報がないため、
(たぶんシート内すべてを読み取っていると思いますが、、、)、その1行を消す方法がわかりません。
下記に簡単なシートの情報を記載します。

シート1 シート2
x y パターン数 x y パターン数
1 2 1 5 4 1
5 4 2 3 7 2
7 1 3 9 7 3

↓マージ後

x y パターン数
1 2 1
5 4 2
7 1 3
5 4 1
3 7 2
9 7 3

このようにしたいです。
現状はエラーメッセージの部分に記載。
シート1,2どちらもA1セルから始まっています。
よろしければ教えてください。

プラスαでパターン数を1.2.3.4.5.6.………のようにしたいですが、
今回はまず、マージできることが最優先なので余裕があれば教えていただきたいです。

発生している問題・エラーメッセージ

↓マージ後 x y パターン数 1 2 1 5 4 2 7 1 3 x y パターン数 5 4 1 3 7 2 9 7 3

該当のソースコード

VBA

1Sub 結合() 2 wpath = Range("B3") 3 wfile = Dir(wpath & "\") 4 flag = 0 5 Do While wfile <> "" 6If InStr(wfile, ".csv") Then 7flag = flag + 1 8If flag = 1 Then 9FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv" 10Open ThisWorkbook.Path & "\output.csv" For Output As #1 11Close #1 12End If 13Open ThisWorkbook.Path & "\output.csv" For Append As #1 14Open wpath & "\" & wfile For Input As #2 15Do Until EOF(2) 16Line Input #2, w_str 17Print #1, w_str 18Loop 19Close #2 20Close #1 21End If 22wfile = Dir() 23 Loop 24 25 MsgBox "マージ完了", vbInformation 26 27 End Sub

試したこと

補足情報(FW/ツールのバージョンなど)

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答4

0

VBA

1Sub test() 2マージシート名 = "マージシート" 'マージ結果が出力されるシート 3 4Sheets(マージシート名).Select 5見出しxセル位置 = "A1" '各シート見出しが統一されていればx列のアドレス 6見出し行 = 1 '見出し行 7見出しx列 = 1 '見出しの中のxがある列 8パターン数列 = 3 '見出しの中のパターン数がある列 9見出しパターン数位置 = "C1" 'マージ結果シートのパターン数の見出しセル 10x = 0 11For i = 1 To Sheets.Count 12 If Not Sheets(i).Name Like "*" & マージシート名 & "*" Then 13 x = x + 1 14 Sheets(i).Select 15 Range(Cells(見出し行 + 1, 見出しx列), Cells(見出し行, パターン数列).End(xlDown)).Copy 16 Sheets(マージシート名).Select 17 If x = 1 Then 18 Range(見出しxセル位置).Offset(1, 0).PasteSpecial (xlPasteAll) 19 Else 20 Range(見出しxセル位置).End(xlDown).Offset(1, 0).PasteSpecial (xlPasteAll) 21 End If 22 End If 23Next i 24 25With Range(見出しパターン数位置) 26 .Offset(1, 0) = CStr("=row()-1") 27 .Select 28End With 29Selection.Offset(1, 0).AutoFill Destination:=Range(Selection.Offset(1, 0), Selection.End(xlDown)), Type:=xlFillDefault 'パターン数列の調整 30 31End Sub

シート数が多いと若干負荷高いかもしれませんがスクリーンアップデートを切ってから実行すればいいかもしれません

投稿2020/02/22 01:57

編集2020/02/22 02:02
abratani

総合スコア23

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

こんにちはこんばんは。よろしくおねがいいたします。
ちょうど仕事で似たようなものを作っていたところなので、ご紹介いたします。
ご参考になればよいのですが....

まとめたCSVをストレートにCSVにするのではなく、いったんシートの状態にしてから、そのあとにCSVで保存させるようにしました。

※CSVをインポートする方法はいろいろあります。私のこれが最善でも最適でもないです。

VBA

1Option Explicit 2 3Sub MatomeMultiCSVs() 4'n個のCSVをユーザーが任意に選択して、”まとめシート”にまとめるプログラム 5'個々のCSVは同じ配列(カラム数)をしているものとする 6'(実際は、カラム数が違っていても読めてしまいますが) 7'個々のCSVの1行目はヘッダであるものとする 8 9Dim MatomeSheet As Worksheet 10Set MatomeSheet = ThisWorkbook.Worksheets("まとめシート") 11 12Dim SavingFileName As Variant 'まとめシートをCSVで保存するときのファイル名 13 14'開くCSV群。複数あり。 15Dim myCSVs As Variant 16 17Dim I As Long '配列のインデックス番号 18 19Dim f As Long '開くCSV群の数 20 21Dim Header As String 'ヘッダ行を読むけど捨てるためだけに使っています 22 23Dim r As Long 'レポートシートの行番号です 24 25'一個のCSVの1行ぶんの文字列です 26Dim strCSV As String 27 28'一個のCSVの1行ぶんを、配列に格納するためのものです 29Dim ArrCSV As Variant 30 31Dim FileCount As Long '処理したファイルの数 32Dim LineCount As Long '処理した行数 33 34FileCount = 0 'ファイル数カウンタをリセット 35LineCount = 0 '行数カウンタをリセット 36 37'まとめシートを念のためクリアしておく 38MatomeSheet.Cells.EntireColumn.Clear 39 40'CSVを開きます 41myCSVs = Application.GetOpenFilename( _ 42fileFilter:="CSVファイル,*.csv", _ 43Title:="読み込むCSVを選択してください. 複数選択が可能です.", _ 44MultiSelect:=True) 45 46'キャンセルボタンを押された場合の処理 47If IsArray(myCSVs) = False Then 48 MsgBox "キャンセルされました" 49 Exit Sub 50End If 51 52r = 1 'まとめシートの1行目からスタート 53 54For f = 1 To UBound(myCSVs) 55 'CSVファイルを開きます 56 Open myCSVs(f) For Input As #1 57 FileCount = FileCount + 1 58 59 '2番目のCSV以降は、1行目(ヘッダ)は読み込むが使わない 60 If f > 1 Then 61 Line Input #1, Header 62 End If 63 64 Do Until EOF(1) 65 Line Input #1, myCSVs(f) 66 67 'CSVの一行分を、配列に格納します 68 ArrCSV = Split(myCSVs(f), ",") 69 For I = 0 To UBound(ArrCSV) 70 MatomeSheet.Cells(r, I + 1) = ArrCSV(I) 71 Next I 72 73 'ここで行送りします 74 r = r + 1 75 LineCount = LineCount + 1 76 'CSVファイルの次の行へシフトします 77 Loop 78 79 'CSVファイルを閉じます 80 Close #1 81 82Next f 83 84'まとめシートをアクティベートします 85MatomeSheet.Activate 86 87MsgBox "処理が完了しました" & vbNewLine & _ 88 "処理したCSVのファイル数 = " & FileCount & vbNewLine & _ 89 "処理した行数 = " & LineCount 90 91'まとめシートをCSVで保存する 92SavingFileName = Application.GetSaveAsFilename(InitialFileName:="まとめ.csv", _ 93fileFilter:="CSVファイル,*.csv", _ 94Title:="まとめCSVの保存先を指定してください") 95 96'キャンセルボタンを押された場合の処理 97If SavingFileName = False Then 98MsgBox "キャンセルされました" 99Exit Sub 100End If 101 102MatomeSheet.SaveAs SavingFileName, FileFormat:=xlCSV 103MsgBox "保存しました" 104 105End Sub 106 107

投稿2020/02/20 16:19

AkiSaito

総合スコア110

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

テストしていませんが
どうでしょうか

Sub 結合() wpath = Range("B3") wfile = Dir(wpath & "\") 'B3セルのパス内のファイル flag = -1 '1行目(項目)カウントで0にする '一つ目のファイル If InStr(wfile, ".csv") Then FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv" '一つ目のファイルをoutput.csvとしてコピーする 'コピー完了待ち? 非同期エラーでないか? ' Open ThisWorkbook.Path & "\output.csv" For Input As #1 '*修正 Do Until EOF(1) Line Input #1, w_str flag = flag + 1 '一つ目のファイルの行数カウント Loop Close #1 '一つ目のファイル完了 End If wfile = Dir() '二つ目のファイルからループ Do While wfile <> "" If InStr(wfile, ".csv") Then 'ThisWorkbook.Path\output.csv は毎回開いた方が安全? Open ThisWorkbook.Path & "\output.csv" For Append As #1 Open wpath & "\" & wfile For Input As #2 '一ライン目破棄 Line Input #2, w_str '二ライン目から追記 Do Until EOF(2) flag = flag + 1 '通し番号のパターン数 Line Input #2, w_str 'w_str_R = Replace(w_str, Str(flag2), Str(flag), 8) ’?? w_str_R = Left(w_str, 8) & String(4 - Len(Str(flag)), " ") & Str(flag) ' 8文字目以降を通し番号に置き換え(右揃え必要?) Print #1, w_str_R Loop Close #2 Close #1 End If wfile = Dir() Loop MsgBox "マージ完了", vbInformation End Sub

投稿2020/02/20 12:37

編集2020/02/20 13:27
sinzou

総合スコア392

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ベストアンサー

やっつけですが、こんな感じでしょうか。
もちろん動作確認はしていません!

VBA

1Sub 結合() 2 wpath = Range("B3") 3 wfile = Dir(wpath & "\") 4 flag = 0 5 Do While wfile <> "" 6 If InStr(wfile, ".csv") Then 7 flag = flag + 1 8 If flag = 1 Then 9 FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv" 10 Open ThisWorkbook.Path & "\output.csv" For Output As #1 11 Close #1 12 End If 13 Open ThisWorkbook.Path & "\output.csv" For Append As #1 14 Open wpath & "\" & wfile For Input As #2 15 ' 1行目 16 Line Input #2, w_str 17 If flag = 1 Then 18 Print #1, w_str 19 End If 20 ' 2行目以降 21 Do Until EOF(2) 22 Line Input #2, w_str 23 Print #1, w_str 24 Loop 25 Close #2 26 Close #1 27 End If 28 wfile = Dir() 29 Loop 30 31 MsgBox "マージ完了", vbInformation 32 33End Sub 34

投稿2020/02/20 10:36

ttyp03

総合スコア17000

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kitagawasho

2020/02/20 11:00

outputが出てきません、、、 このワークシートと同じ場所に出ると思っていますが違う場所に出力されますか?
ttyp03

2020/02/20 12:06

えっと、ファイルに出力されるんですが…
sinzou

2020/02/20 12:27

ThisWorkbook.Path & "\output.csv" xlsmファイル保存されてれば、作成されるかと…
ttyp03

2020/02/20 23:44

昨日は取り急ぎ回答しましたが、再度確認です。 ご提示のコードは複数のCSVファイルをマージして、別のファイル(output.csv)に出力するものです。 もしワークシートに出力(表示)したいというのであればまったくの別物なので改めてそのコードの提示をお願いします。 ただ現状の物でもoutput.csvをExcelで開けば確認したいことはできていると思います。 「VBAに詳しくない」とかよりも、まずは要件・仕様をよく確認してください。 あとたぶんワークブックとかCSVファイルとか同じものと思われている節があるので、用語の確認もお願いします。
kitagawasho

2020/02/21 00:31

朝確認したら、パスが違っていました。。。 自分の確認不足です。 本当にすみません。。。 outputが出ることを確認しました。 対応ありがとうございました。。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.35%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問