ここから本文です

【Excelの集計作業について】 こんにちは。 Excel、マクロが強い方にぜひ...

har********さん

2020/1/815:44:15

【Excelの集計作業について】


こんにちは。

Excel、マクロが強い方にぜひお力をお貸し頂きたいです。

現在Excelで集計作業を行っています。

前提として、集計用のExcelファイル(ファイル名:集計表)が1つ
20個のExcelファイル(ファイル名:ファイル①、ファイル②、ファイル③他)
合計21個のExcelファイルがあります。

この20個のExcelファイル(ファイル①他)の
各シートの特定の範囲(例:ファイル①の、シートAのA1:C4迄の範囲)を、
集計用ファイルの、sheet1の、A1:C4の範囲にデータを飛ばしたいのですが、
どのようにするのが最も効率的であるか教えて頂きたいです。

現在、一つ一つのファイルを開いて、コピーして、、集計用ファイルに貼り付けて、、、
という作業を繰り返し行っている為、非常に労力がかかっております…
マクロも少しずつ勉強しているのですが、まだ覚え始めたばかりで知識が乏しく、ぜひ詳しい方にお力添えを頂きたいです。

宜しくお願い致します。

閲覧数:
93
回答数:
3
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

30246kikuさん

2020/1/909:49:15

以下でどうなりますか

この方法は、
・シート名がわかっている
・取得範囲がわかっている
の場合に使える方法かと・・・

ファイルを開かずにデータを入手するので、かなり速いかと・・・
20ファイル程度であれば、結果は瞬時に・・・

こまかめの説明は、以下を参照のこと

2013エクセル、複数のエクセルファイルから、決まったシートのセル
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q141738537...


確認手順として

確認用フォルダを新規作成します
新規ブックを開き、標準モジュールに以下を記述します
一旦、新規作成したフォルダに保存します
testData を実行して、確認用ファイル20個作成します
Samp1 を実行してみます

どうなりますか


Option Explicit

Dim vA As Variant

Public Function mymyVal(v As Variant)
   vA = v
End Function

Public Sub Samp1()
   Dim sPath As String, sFile As String
   Dim sF As String
   Dim rng As Range
   Const CF As String = "=mymyVal('{%1}[{%2}]シートA'!A1:C4)"

   sPath = ThisWorkbook.Path & "\"
   sFile = Dir(sPath & "*.xls*")
   If (sFile <> "") Then
      Application.ScreenUpdating = False
      With Worksheets("Sheet1")
         Set rng = .Range("A1")
         rng.Resize(, 4).EntireColumn.ClearContents
      End With
      sF = Replace(CF, "{%1}", sPath)
      Do
         If (sFile <> ThisWorkbook.Name) Then
            On Error Resume Next
            rng.Formula = Replace(sF, "{%2}", sFile)
            On Error GoTo 0
            rng.Resize(UBound(vA), UBound(vA, 2)).Value = vA
            Set rng = rng.Offset(UBound(vA))
         End If
         sFile = Dir()
      Loop While (sFile <> "")
      Application.ScreenUpdating = True
   End If
End Sub


' 確認用環境作成

Public Sub testData()
   Dim sPath As String, sFile As String
   Dim rng As Range, r As Range
   Dim i As Long, k As Long, n As Long
   Const CFC As Long = 20 ' 確認用ファイル数
   Const CRNG As String = "A1:D10"

   sPath = ThisWorkbook.Path & "\"
   If (sPath = "\") Then Exit Sub

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   With Workbooks.Add
      With .Worksheets(1)
         .Name = "シートA"
         Set rng = .Range(CRNG)
      End With
      i = 1
      For Each r In rng
         r.Value = i & "_" & r.Address(False, False)
      Next
      sFile = "test" & Format(i, "00")
      .SaveAs sPath & sFile, xlOpenXMLWorkbook

      For i = 2 To CFC
         rng.Replace i - 1 & "_", i & "_", xlPart
         sFile = "test" & Format(i, "00")
         .SaveAs sPath & sFile, xlOpenXMLWorkbook
      Next
      .Close False
   End With
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
End Sub

  • 30246kikuさん

    2020/1/1011:34:21

    訂正?

    > rng.Resize(, 4).EntireColumn.ClearContents

    この部分、書き出しの4列分を綺麗にしてましたが、

    > A1:C4

    の範囲であれば、

    rng.Resize(, 3).EntireColumn.ClearContents

    と、3列分で・・・

    というのは、

    4列目にファイル名でも入れようか・・・・
    思っただけで、その処理記述していなかったので・・・
    やろうとしてやらなかった残骸になります

    4列目に消してマズイものがなかったらそのままでも・・・

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

nishi6さん

2020/1/816:49:58

やりたいことは何でしょうか

>集計用ファイルの、sheet1の、A1:C4の範囲にデータを飛ばしたい
これをマクロでやっても、最後は20個目のファイルがA1:C4に記録されるだけです。

各シートのA1:C4の4行×3列を、集計用ブックのSheet1に順じ追記するようにしました。
「path」はご自分の環境に合わせて編集してください。

Sub TotalBook()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Dim path As String
Dim filename As String
Dim f As String
path = "N:\****\****\"

Application.ScreenUpdating = False

f = 0
filename = Dir(path & "*.xls*")
While filename <> ""
If filename <> wb.Name Then
Workbooks.Open (path & filename)
Set wb2 = Workbooks.Open(path & filename)
Set ws2 = wb2.Worksheets("Sheet1")
ws.Range("A" & (f * 4 + 1) & ":C" & (f * 4 + 4)) = ws2.Range("A1:C4").Value
f = f + 1

wb2.Close
End If

filename = Dir
Wend

Application.ScreenUpdating = True
End Sub

Chiquilinさん

2020/1/816:23:36

別にマクロを組まなくてもクエリで20ファイルのデータを結合
して読み込めばいでしょう。

https://www.crie.co.jp/chokotech/detail/339/

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる