Remove From My Forums

複数の別ブックから所定のセルの情報を集約する方法について

質問
0

サインインして投票

皆様、初歩的な質問をしてしまい、大変申し訳ございません。

VBA初心者のものです。

１００時間以上VBAについて調べてみたのですが、

どうしても上手くいかず、質問させていただきました。

状況としては、

毎日の売上のデータをブックごとに管理しているのですが、

その各ブックのデータの１年間のトータルの情報を１つのシートに集約したいと考えております。

集約する予定のシートは、（ファイル名：集約、集約するシート名：集約シート）です。

売上日報のファイル名は基本「2015.〇〇」"C:\Users\2222\Desktop\売上日報\2015.11"

となっております。

「2015.11」のファイルの中に、「2015.11.1」「2015.11.2」～「2015.11.30」という形でブックが収納されています。

行いたいこととしましては、

各ブックにsheet1（売上日報のデータが記載されているシート名）の「M10 : N37」のセルのデータを

C:\Users\2222\Desktopにあるファイル名：book1の

シート名：集約シートに日ごとに並べたいと考えております。

最終的にはこれを1年間分の情報を並べて、比較したいと考えているのですが、

どうしてもVBAがうまく作れません。

そもそも

私が作ったコードも載せずに質問をすることが虫が良すぎるのは重々承知しております。

もしお力添えをいただけるのであれば

大変恐縮なのですが、ご教授していただけますと幸いです。

※日付は集約するシートに記載がなくても構いません。

順番通りの場合は、自分で数えるようにいたします。

大変お手数をおかけいたしますが、

よろしくお願い申し上げます。

2017年10月19日 8:13

返信

|

引用

回答

サインインして投票

こんな？

Const TARGETYEAR As Integer = 2015
Const FOLDER As String = "D:\Users\ゆーざー\Desktop\売上日報\"
Const RANGENAME As String = "M10:N37"

Function GetFilePath(ByVal y As Integer, ByVal m As Integer) As String
    GetFilePath = FOLDER & y & "." & m & ".xlsx"
End Function

Sub CreateTestData()
    Dim dt As Date
    Dim m As Integer
    Dim d As Integer
    Dim wbMonth As Workbook
    Dim sh As Worksheet
    Dim rng As Range
    
    dt = DateSerial(TARGETYEAR, 1, 1)
    Do While Year(dt) = TARGETYEAR
        y = Year(dt)
        d = Day(dt)
        m = Month(dt)
        
        If (Day(dt) = 1) Then
            Set wbMonth = Application.Workbooks.Add
            Call wbMonth.SaveAs(GetFilePath(y, m))
            Set sh = wbMonth.Worksheets(1)
        Else
            Set sh = wbMonth.Worksheets.Add
        End If
    
        sh.Name = y & "." & m & "." & d
        For Each rng In sh.Range(RANGENAME)
            rng.Value = m & "_" & d & "_" & rng.Address
        Next

        dt = DateAdd("d", 1, dt)
        If (Day(dt) = 1) Then
            wbMonth.Save
            wbMonth.Close
        End If
    Loop
End Sub

Public Sub CopyToAggregate()
    Dim dt As Date
    Dim m As Integer
    Dim d As Integer
    Dim wbMonth As Workbook
    Dim shDay As Worksheet
    
    Dim shs(1 To 31) As Worksheet
    
    Dim wbTarget As Workbook
    Dim shTarget As Worksheet
    Dim rngA As Range
    Dim rng As Range
    Dim rngSource As Range
    
    Set wbTarget = Application.Workbooks.Add
    Set shTarget = wbTarget.Worksheets(1)
    shTarget.Name = "集計シート"
    
    Dim rngHeader
    Set rngHeader = shTarget.Range("B1")
    For Each rngSource In shTarget.Range(RANGENAME)
        rngHeader.Value = rngSource.Address
        Set rngHeader = rngHeader.Offset(0, 1)
    Next
    
    Set rngA = Range("A1")

    dt = DateSerial(TARGETYEAR, 1, 1)
    Do While Year(dt) = TARGETYEAR
        y = Year(dt)
        d = Day(dt)
        m = Month(dt)
        
        If (Day(dt) = 1) Then
            Set wbMonth = Application.Workbooks.Open(GetFilePath(y, m))
        End If
        
        Set rngA = rngA.Offset(1, 0)
        rngA.Value = dt
        
        Set rng = rngA.Offset(0, 1)
        
        Set shDay = Nothing
        On Error Resume Next
        Set shDay = wbMonth.Worksheets(y & "." & m & "." & d)
        On Error GoTo 0
        If Not (shDay Is Nothing) Then
            For Each rngSource In shDay.Range(RANGENAME)
                rng.Value = rngSource.Value
                Set rng = rng.Offset(0, 1)
            Next
        End If
        
        dt = DateAdd("d", 1, dt)
        If (Day(dt) = 1) Then
            wbMonth.Close
        End If
    Loop
End Sub

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

回答としてマーク栗下望Microsoft employee, Moderator 2017年10月25日 1:51

2017年10月19日 23:38

トップ回答者

複数の別ブックから所定のセルの情報を集約する方法について

質問

回答