[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数の複数行あるエクセルファイルを１つのエクセルファイルで一括集計したい』（にし）
ある他サイトに掲載されていたマクロを参考にして、
以下のマクロを利用しております。
・転記先のエクセルファイルが起動→「開発」タブの「Visual Basic」ボタンをクリック
・起動した画面のメニューから「挿入」の「標準モジュール」をクリック
空白セル部分に以下を記入しています。
Sub tenki()
Dim folder As String
Dim file As String
Dim book As Workbook
Dim i As Integer
i = 2
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folder = .SelectedItems(1)
End If
End With
file = Dir(folder & "\*.xlsx")
Do While file <> ""
Set book = Workbooks.Open(folder & "\" & file)
ThisWorkbook.Worksheets("Sheet1").Range("A" & CStr(i)).Value = book.Worksheets("Sheet2").Range("C13").Value
file = Dir()
i = i + 1
Application.DisplayAlerts = False
book.Close
Loop
End Sub
本来は、転記したい元のExcelファイルは、Sheet2のC13セルだけではなく、Sheet2のC14セル〜C17セルも一緒に、
1つのExcelファイルで一括集計したいのですが、その方法がわからなかったため、現在は、
上記掲載のExcelファイル（C13行転記用）のようなExcelファイル行ごとさらに4つ用意し、
出力された5つのExcelファイルを手動で合算しております。
もし、可能であれば、
集約したExcelファイルにて、一つ目のExcelファイルの
Sheet2のC13セル→A2セル、Sheet2のC14セル→A3セル、Sheet2のC15セル→A4セル、Sheet2のC16セル→A5セル、Sheet2のC17セル→A6セルが転記され、
次にExcelシートで同様に、
Sheet2のC13セル→A7セル、Sheet2のC14セル→A8セル、Sheet2のC15セル→A9セル、Sheet2のC16セル→A10セル、Sheet2のC17セル→A11セルが転記される・・・のような動きにしたいと思っております。
もし何か良い方法があればお知恵を拝借いただければ幸いです。
どうぞよろしくお願いいたします。
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
ファイルを開かない方法で
Sub tenki()
Dim folder As String
Dim file As String
Dim book As Workbook
Dim i As Integer, n As Long
n = 1
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folder = .SelectedItems(1)
End If
End With
file = Dir(folder & "\*.xls")
Do While file <> ""
For i = 13 To 17
n = n + 1
ThisWorkbook.Sheets("sheet1").Cells(n, 1).Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]sheet2'!r" & i & "c3")
Next
file = Dir
Loop
End Sub
（seiya） 2019/05/13(月) 10:50
早速のご返信ありがとうございます。
教えていただきました方法で、
C13セル → A2セルへのコピーは無事にできたのですが、
実際のファイルは、
C13セル → A2セル にコピー
だけではなく、
F13セル → B2セル にコピー
S13セル → C2セル にコピー
等、複数のセルを転記したいのですが、
教えていただきました構文を全く理解できていないことが原因なのですが、
構文をどのように修正すればよいのかがわかりませんでした。
また、転記元Excelは、実際には、"Sheet2"ではなく、"入替"という文字列なのですが、
単純に"Sheet2"の文字列を"入替"に変更したたけでは、実行したときに、
「ワークシートの再指定」というダイアログが出てしまい、正しく転記できませんでした。
また、集約するのは、ひとつのExcelで複数シートにまたがっており、
先ほどの"入替"シートだけではなく、"返却"シートからも転記しております。
そのため、例えば"返却"シート内の"Q15"セルを転記先ExcelのSheet1のD2 にコピーしたい
場合についても教えていただけないでしょうか。
教えてほしいばかりで大変恐縮なのですが、
上記方法についてもご教示いただけないでしょうか。
（にし） 2019/05/13(月) 13:34
ここから下
Sub tenki()
Dim folder As String
Dim file As String
Dim book As Workbook
Dim i As Integer
i = 2
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folder = .SelectedItems(1)
End If
End With
file = Dir(folder & "\*.xlsx")
Do While file <> ""
Set book = Workbooks.Open(folder & "\" & file)
ThisWorkbook.Worksheets("Sheet1").Range("A" & CStr(i)).Value = book.Worksheets("入替").Range("C13").Value
ThisWorkbook.Worksheets("Sheet1").Range("B" & CStr(i)).Value = book.Worksheets("入替").Range("F13").Value
ThisWorkbook.Worksheets("Sheet1").Range("C" & CStr(i)).Value = book.Worksheets("入替").Range("S13").Value
ThisWorkbook.Worksheets("Sheet1").Range("D" & CStr(i)).Value = book.Worksheets("返却").Range("Q15").Value
file = Dir()
i = i + 1
Application.DisplayAlerts = False
book.Close
Loop
End Sub
ここより上
恐れ入りますが、どうぞよろしくお願いいたします。
（にし） 2019/05/13(月) 14:37
> ThisWorkbook.Sheets("sheet1").Cells(n, 1).Value = _
> ExecuteExcel4Macro("'" & folder & "\[" & file & "]sheet2'!r" & i & "c3")
に他の列分を追加するだけです。
ThisWorkbook.Sheets("sheet1").Cells(n, "a").Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]sheet2'!r" & i & "c3")
ThisWorkbook.Sheets("sheet1").Cells(n, "b").Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]sheet2'!r" & i & "c6")
ThisWorkbook.Sheets("sheet1").Cells(n, "c").Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]sheet2'!r" & i & "c19")
ThisWorkbook.Sheets("sheet1").Cells(n, "d").Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]sheet2'!r" & i & "c17")
ExecuteExcel4Macroで指定する計算文字列のセルアドレスはR1C1形式で記述しなければなりません。 （seiya） 2019/05/13(月) 14:43
お教えいただきました件、ようやく理解できるようになってきました。
この度は、ありがとうございました。
（にし） 2019/05/14(火) 14:01
教えていただきました内容はうまくいくようになったのですが、
続きの内容で思考錯誤してみてもうまくいかない件があり、教えていただけないでしょうか。
実際の転記元のExcelファイルはC13セル〜C17セルだけではなく、
別のセル範囲（C23セル〜C27セル）も集約後のExcelファイルのC13セル〜C17セルで出力した結果の同じ行に転記をしたいのですが、
以下のようにマクロ構文を組むと、別の行として転記されてしまいます。
Sub tenki()
Dim folder As String
Dim file As String
Dim book As Workbook
Dim i As Integer, n As Long
n = 1
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folder = .SelectedItems(1)
End If
End With
file = Dir(folder & "\*.xls")
Do While file <> ""
For i = 13 To 17
n = n + 1
ThisWorkbook.Sheets("sheet1").Cells(n, 3).Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]入替'!r" & i & "c12")
Next
file = Dir
Loop
file = Dir(folder & "\*.xls")
Do While file <> ""
For j = 23 To 27
n = n + 1
ThisWorkbook.Sheets("sheet1").Cells(n, 19).Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]入替'!r" & ｊ & "c3")
Next
file = Dir
Loop
End Sub
同じ行に転記する方法がありましたら、教えていただけますと幸いです。
どうぞよろしくお願いいたします。
（にし） 2019/05/14(火) 15:41
Do While file <> ""
For i = 13 To 17
n = n + 1
ThisWorkbook.Sheets("sheet1").Cells(n, 3).Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]入替'!r" & i & "c12")
ThisWorkbook.Sheets("sheet1").Cells(n, 19).Value = _
ExecuteExcel4Macro("'" & folder & "\[" & file & "]入替'!r" & i+10 & "c3")
Next
file = Dir
Loop
で、2つ目のDo Loopを削除 こういうことですか？ （seiya） 2019/05/14(火) 15:47
ご返信ありがとうございます。
やりたかったことがすべて解決いたしました。
しかも、ファイルをひとつひとつ開くことなく集計できるようになったため、
作業時間が大幅に短縮できるようになりました。
このたびは、本当にありがとうございました。
（にし） 2019/05/14(火) 16:16
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.