- ベストアンサー
エクセルマクロでファイルを結合する方法
- エクセルのマクロを使用して、ファイルA.xlsのA列とB列にファイルB.csvを、最終行にファイルC.csvを結合する方法を教えてください。
- 注意点として、実際のファイルの行数は毎回変動するため、柔軟に結合できる方法が必要です。
- また、ファイルA.xlsのC列には関数が含まれており、結合した情報を計算して表示する必要があります。
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
こんなのはどうでしょうか？ B.csvとC.csvが2列しかない場合は Sub sample() Dim r As Long r = 1 Columns("A:B").Clear '一応クリアする場合 Workbooks.Open "C:\B.csv" ActiveSheet.UsedRange.Copy ThisWorkbook.ActiveSheet.Range("A1") r = r + ActiveSheet.UsedRange.Rows.Count ActiveWorkbook.Close False Workbooks.Open "C:\C.csv" ActiveSheet.UsedRange.Copy ThisWorkbook.ActiveSheet.Range("A" & r) ActiveWorkbook.Close False End Sub B.csvとC.csvが3列目(C列)以降もある場合は Sub sample() Dim r As Long r = 1 Columns("A:B").Clear '一応クリアする場合 Workbooks.Open "C:\B.csv" Application.Intersect(Columns("A:B"), ActiveSheet.UsedRange).Copy ThisWorkbook.ActiveSheet.Range("A1") r = r + ActiveSheet.UsedRange.Rows.Count ActiveWorkbook.Close False Workbooks.Open "C:\C.csv" Application.Intersect(Columns("A:B"), ActiveSheet.UsedRange).Copy ThisWorkbook.ActiveSheet.Range("A" & r) ActiveWorkbook.Close False End Sub
その他の回答 (1)
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 今のところ、ファイルオープンダイアログで、ファイルを複数選択した時に、順序を選べませんが、複数選択可能です。 注意としては、書き込もうとする最初のセルに値が入っていると、「上書きしますか？」と聞いてきます。そうすると、最初の右の関数自体も無視されますので、CSVが右の関数のデータ列よりも大きいと、上書きされます。 >実際は関数が入っていて 本来、関数は、マクロで入れれば、もっと簡単なマクロにできるはずです。 '------------------------------------------- Sub ImportCSV() ''間にCSVデータを挿入するマクロ Dim i As Long Dim j As Long Dim FileNames As Variant Dim textLine As String Dim myArray As Variant Dim fNum As Integer Dim n As Variant Dim sh As Worksheet Dim flg As Boolean '========================================= ''設定 i = 1 '開始行 '========================================= Set sh = ActiveSheet '列幅の指定 'j =1 は、無視される j = sh.Cells(i, 1).End(xlToRight).Column FileNames = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", 1, "複数ファイル名取得", , True) If VarType(FileNames) = vbBoolean Then Exit Sub For Each n In FileNames fNum = FreeFile() Application.ScreenUpdating = False Open n For Input As #fNum Do While Not EOF(fNum) Line Input #fNum, textLine myArray = Split(textLine, ",") 'デリミタは、「,」 If sh.Cells(i, 1).Value <> "" And flg = False Then If MsgBox("上書きしますが、よろしいですか？", vbOKCancel + vbQuestion) = vbCancel Then Exit Sub End If 'フラッグ flg = True j = Columns.Count End If If j < Columns.Count Then sh.Cells(i, 1).Resize(, j - 1).Value = myArray Else sh.Cells(i, 1).Resize(, UBound(myArray) + 1).Value = myArray End If i = i + 1 Loop Application.ScreenUpdating = True Close #fNum Next n Set sh = Nothing Beep End Sub
