LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@ShineYamamoto(M Yamamoto)

複数の別シートからデータを取得して合計値を求める

Posted at

とあるデータが複数のシートに分かれており、合計用のシートに合計を出力する方法を考える。
例えば、日別に商品別売上のシートが作成されており、商品ごとに売上合計を取得する場合は単純なsum関数では対応できない。今回は合計を取得する方法を考えてみる。

1：まずは単純に日別のシートをすべて足し合わせるケースを考える。

最終的にはシート毎に様々な商品の売り上げ情報がある場合を想定し、一気にすべての商品の売り上げの合計値を出力したいが、いきなり考えると複雑なため、まずは単純化してプログラムを作成する。
今回は各シートにはそれぞれA1セルのみデータが存在するとし、平日と土日のデータを無差別に扱う。

特に、今回のプログラムの特徴として、出力方法を数値ではなく計算式にしていることがあげられる。複数の人がこのエクセルを扱う場合、合計の数値だけでは計算過程がわからずブラックボックス化してしまう恐れがあるからである。

条件：
　参照シート名（例）：20250401
　出力先シート名：合計

Option Explicit

Sub 日付シート合計式作成()

    ' 該当する日付を指定する
    Dim yearVal As Integer: yearVal = 2025
    Dim monthVal As Integer: monthVal = 4

    Dim startDate As Date: startDate = DateSerial(yearVal, monthVal, 1)
    Dim endDate As Date: endDate = DateSerial(yearVal, monthVal + 1, 0)
    
    ' 計算式のベースを作成
    Dim formulaParts As String: formulaParts = "=" 'ここから右に数式を足し合わせる
    
    ' 出力先シート
    Dim summarySheet As Worksheet: Set summarySheet = ThisWorkbook.Sheets("合計")
    
    Dim currentDate As Date
    Dim sheetName As String
    
    ' 各シートの値を計算式に組み込んでいく
    For currentDate = startDate To endDate
        sheetName = Format(currentDate, "yyyymmdd")
        
        ' 数式に追記する
        If Len(formulaParts) > 1 Then formulaParts = formulaParts & "+"
        formulaParts = formulaParts & "'" & sheetName & "'!A1"
    Next currentDate
    
    If Len(formulaParts) > 1 Then
        summarySheet.Range("A1").Formula = formulaParts
    Else
        summarySheet.Range("A1").ClearContents
    End If
End Sub

1-1：該当する日付を指定する

    Dim yearVal As Integer: yearVal = 2025
    Dim monthVal As Integer: monthVal = 4

    Dim startDate As Date: startDate = DateSerial(yearVal, monthVal, 1)
    Dim endDate As Date: endDate = DateSerial(yearVal, monthVal + 1, 0)

yearVal → 年を指定
monthVal → 月を指定
プログラムの中で日付を指定しているが、必要に応じてユーザーフォームなどから取得する。
DateSerialで日付情報を格納し、のちの処理をしやすくしている。
monthVal + 1 で次月になってしまうが、3つ目の引数を0にすることにより次月の0日目、すなわち今月の最終日としている。

1-2：計算式のベースを作成

    Dim formulaParts As String: formulaParts = "="

formulaParts → 計算式を格納する変数
デフォルトで ＝ をあらかじめ格納しておくことで、格納用のプログラムを簡略化できる。

1-3：出力先のシートを変数として定義

    Dim summarySheet As Worksheet: Set summarySheet = ThisWorkbook.Sheets("合計")

"合計"シートに最終的に出力する

1-4：for文で使う変数を定義

    Dim currentDate As Date
    Dim sheetName As String

currentDate → 反復処理の変数
sheetName → 参照するシートの名前（例：20250415）

1-5：For文処理

    For currentDate = startDate To endDate
        sheetName = Format(currentDate, "yyyymmdd")
        
        ' 数式に追記する
        If Len(formulaParts) > 1 Then formulaParts = formulaParts & "+"
        formulaParts = formulaParts & "'" & sheetName & "'!A1"
    Next currentDate

月初めから月末まで繰り返す。
もしformulaPartsの文字数が1より大きければデフォルトから何かしら付け足されたことになるので、 "+" をつけ足しておく。まだ何もつけ足されていない状態、つまりformulaParts = "="　の状態では最初に "+" をくっつける必要がないのでこのように処理している。
次の行で実際に該当月のシートのA1セルを足す計算式を追記している。
プログラムの中に直接 !A1 と書き込んでいるが、汎用性を考えると変数とすることが望ましい。

1-6：出力先のシートに計算式を入力する

    If Len(formulaParts) > 1 Then
        summarySheet.Range("A1").Formula = formulaParts
    Else
        summarySheet.Range("A1").ClearContents
    End If

何らかの処理をしている場合は　"合計" シートのA1セルに計算式を書き込むようにしている。
まぁ、実際にはそもそも数式に何もつけ足されていない状態になる場合は参照用のシートが見つからないケースなわけで、その段階でエラーを吐くのでここでIf分を使う意味はない。なんとなくしているだけである。

1-7：実行

このプログラムを実行すると合計シートのA1セルは以下のようになる。

='20250401'!A1+'20250402'!A1+'20250403'!A1+...+'20250430'!A1

期待通り1日から月末の30日まで足し合わせることができた。
しかし、実際には平日と土日など、曜日によって合計の計算を分けたいと考えることも多い。例えば飲食店は平日よりも土日祝が一般には売り上げが大きいため、平日と土日祝で切り分けて売り上げを考えることが多い。
次の章では平日と土日祝で計算式を切り分け、それぞれ出力できるように改良する。

2：平日と土日祝の計算式を分割する

それでは少し実用的な例として平日と土日祝のデータを分割して足し合わせてみる。
土日祝のみではなく任意の日にちを選択することも簡単にできる。

祝日の一覧は、新たに "祝日リスト" シートを作成し、A列に羅列しておく。任意の日付を指定することもできる。
土日祝は "土日祝合計" シートに結果を書き込むことにした。

Option Explicit

Sub 平日土日祝別日付シート合計式作成()
     
     ' 「祝日リスト」シートを読み込んで祝日一覧を辞書に格納
     Dim holidayDict As Object: Set holidayDict = CreateObject("Scripting.Dictionary") ' 最終的に格納するための変数
     Dim holidayListSheet As Worksheet: Set holidayListSheet = Worksheets("祝日リスト")
     Dim holidayCell As Range
     Dim holidayVal As String
     Dim holidayDate As Date
     Dim formattedDate As String
     
     For Each holidayCell In holidayListSheet.Range("A1:A100")
        If Trim(holidayCell.Value) <> "" Then
            holidayVal = Trim(CStr(holidayCell.Value))
            
            On Error Resume Next
            If IsNumeric(holidayVal) And Len(holidayVal) = 8 Then
                ' 8桁の数値文字列としてそのまま yyyymmdd の形式とみなす
                formattedDate = holidayVal
            Else
                ' それ以外は日付データとして解釈して yyyymmdd に整理
                holidayDate = CDate(holidayCell.Value)
                If Err.Number = 0 Then
                    formattedDate = Format(holidayDate, "yyyymmdd")
                Else
                    formattedDate = "" ' 無効な値であればスキップ
                End If
            End If
            Err.Clear
            On Error GoTo 0
            
            ' 辞書に格納する
            If formattedDate <> "" Then
                holidayDict(formattedDate) = True
            End If
        End If
    Next holidayCell
     
    ' 該当する日付を指定する
    Dim yearVal As Integer: yearVal = 2025
    Dim monthVal As Integer: monthVal = 4

    Dim startDate As Date: startDate = DateSerial(yearVal, monthVal, 1)
    Dim endDate As Date: endDate = DateSerial(yearVal, monthVal + 1, 0)
    
     ' 計算式のベースを作成
     Dim weekdayFormula As String: weekdayFormula = "="
     Dim holidayFormula As String: holidayFormula = "="
     
    ' 出力先シートを指定
     Dim weekdaySheet As Worksheet: Set weekdaySheet = Worksheets("平日合計")
     Dim holidaySheet As Worksheet: Set holidaySheet = Worksheets("土日祝合計")
     
     ' 各シートの値を計算式に組み込んでいく
     Dim currentDate As Date
     Dim sheetName As String
     Dim wd As Integer
     Dim isHoliday As Boolean
     
     For currentDate = startDate To endDate
        ' シート名を "yyyymmdd" 形式で作成
        sheetName = Format(currentDate, "yyyymmdd")
        
        ' 曜日を取得（日曜＝1、月曜＝2、・・・、土曜＝7）
        wd = Weekday(currentDate, vbSunday)
        
        ' 祝日かどうかを判定（祝日リストに含まれているか）含まれている場合はtrueを返す
        isHoliday = holidayDict.exists(sheetName)
        
        ' 数式に追記する
        If isHoliday Or wd = vbSaturday Or wd = vbSunday Then
            If Len(holidayFormula) > 1 Then holidayFormula = holidayFormula & "+"
            holidayFormula = holidayFormula & "'" & sheetName & "'!A1"
        Else
            If Len(weekdayFormula) > 1 Then weekdayFormula = weekdayFormula & "+"
            weekdayFormula = weekdayFormula & "'" & sheetName & "'!A1"
        End If
        
     Next currentDate
     
     ' 数式として出力（A1セルに式を入力する）
     If Len(weekdayFormula) > 1 Then
        weekdaySheet.Range("A1").Formula = weekdayFormula
    Else
        weekdaySheet.Range("A1").ClearContents
    End If
    
    If Len(holidayFormula) > 1 Then
        holidaySheet.Range("A1").Formula = holidayFormula
    Else
        holidaySheet.Range("A1").ClearContents
    End If
    
End Sub

2-1：祝日一覧を辞書に格納する

2-1-1：必要な変数を定義

     Dim holidayDict As Object: Set holidayDict = CreateObject("Scripting.Dictionary") ' 最終的に格納するための変数
     Dim holidayListSheet As Worksheet: Set holidayListSheet = Worksheets("祝日リスト")
     Dim holidayCell As Range
     Dim holidayVal As String
     Dim holidayDate As Date
     Dim formattedDate As String

holidayDict → 祝日リストを最終的に格納される変数
holidayListSheet → "祝日リスト" シートを格納する変数
holidayCell → 反復処理の変数
holidayVal,holidayDate → 祝日の値を一時保管する臨時変数
formattedDate → エラー処理済みの祝日の値が格納されている臨時変数

2-1-2：For文一覧を辞書に格納する

     For Each holidayCell In holidayListSheet.Range("A1:A100")
        If Trim(holidayCell.Value) <> "" Then
        ///
        End If
    Next holidayCell

"祝日リスト" シートのA1からA100まで繰り返す。
それぞれのセルに値が入っている場合のみ実行し、何も入っていない場合は次のセルに進む。
Trim()を使っているのはもし空白スペースのあるセルがある場合は無視したいため。

2-1-3：セルのデータを日付データに整理する

            holidayVal = Trim(CStr(holidayCell.Value))
            
            On Error Resume Next
            If IsNumeric(holidayVal) And Len(holidayVal) = 8 Then
                ' 8桁の数値文字列としてそのまま yyyymmdd の形式とみなす
                formattedDate = holidayVal
            Else
                ' それ以外は日付データとして解釈して yyyymmdd に整理
                holidayDate = CDate(holidayCell.Value)
                If Err.Number = 0 Then
                    formattedDate = Format(holidayDate, "yyyymmdd")
                Else
                    formattedDate = "" ' 無効な値であればスキップ
                End If
            End If
            Err.Clear
            On Error GoTo 0

holidayCell.Value を文字列として扱い holidayValへ一時保管する。
エラー発生時は日付データではないと判断し無視するため、On Error Resume Next を記載している。
もし holidayVal が数値であり、かつ8文字の場合はデータを加工せず、そのまま辞書に格納するための変数 formattedDate へ格納する。
holidayVal が数値では無ければ日付データに加工していく。

                ' それ以外は日付データとして解釈して yyyymmdd に整理
                holidayDate = CDate(holidayCell.Value)
                If Err.Number = 0 Then
                    formattedDate = Format(holidayDate, "yyyymmdd")
                Else
                    formattedDate = "" ' 無効な値であればスキップ
                End If

CDate() で日付データに変更し、もしエラーがない場合はFormat()で "yyyymmdd" に加工する。

2-1-4：辞書に格納する

            ' 辞書に格納する
           If formattedDate <> "" Then
               holidayDict(formattedDate) = True
           End If

formattedDate にデータが入っていれば辞書に登録する。辞書のプロパティの True は重要ではなく、データが存在していることが重要。

2-2：曜日を取得

        wd = Weekday(currentDate, vbSunday)

For文の中で currentDate の曜日を取得するため、 Weekday() メソッドを使用している。日曜日を1とした。

2-3：祝日かどうかを判定

        isHoliday = holidayDict.exists(sheetName)

For文の該当日が祝日リストに含まれているかチェック。exists メソッドを使い存在しているか確認し、存在して入れば True を返す。

2-4：数式に追記する

        If isHoliday Or wd = vbSaturday Or wd = vbSunday Then
            If Len(holidayFormula) > 1 Then holidayFormula = holidayFormula & "+"
            holidayFormula = holidayFormula & "'" & sheetName & "'!A1"
        Else
            If Len(weekdayFormula) > 1 Then weekdayFormula = weekdayFormula & "+"
            weekdayFormula = weekdayFormula & "'" & sheetName & "'!A1"
        End If

祝日リストに含まれているか、土曜または日曜日の場合は holidayFormula の数式を追記する。
それ以外の場合は weekdayFormula の数式を追記する。

実行してみると平日合計シートと土日祝合計シートのA1セルに正しい数式が入力できていることを確かめてみてほしい。

3：複数のセルの場合にも対応させる

Sub 平日土日祝別日付シート合計式作成()
   
   ' 「祝日リスト」シートを読み込んで祝日一覧を辞書に格納
   Dim holidayDict As Object: Set holidayDict = CreateObject("Scripting.Dictionary")
   Dim holidayListSheet As Worksheet: Set holidayListSheet = Worksheets("祝日リスト")
   Dim holidayCell As Range
   Dim holidayVal As String
   Dim holidayDate As Date
   Dim formattedDate As String
   
   For Each holidayCell In holidayListSheet.Range("A1:A100")
       If Trim(holidayCell.Value) <> "" Then
           holidayVal = Trim(CStr(holidayCell.Value))
           
           On Error Resume Next
           If IsNumeric(holidayVal) And Len(holidayVal) = 8 Then
               ' 8桁の数値文字列としてそのまま yyyymmdd の形式とみなす
               formattedDate = holidayVal
           Else
               ' それ以外は日付データとして解釈して yyyymmdd に整理
               holidayDate = CDate(holidayCell.Value)
               If Err.Number = 0 Then
                   formattedDate = Format(holidayDate, "yyyymmdd")
               Else
                   formattedDate = ""
               End If
           End If
           Err.Clear
           On Error GoTo 0
           
           ' 辞書に格納する
           If formattedDate <> "" Then
               holidayDict(formattedDate) = True
           End If
       End If
   Next holidayCell
   
   ' 該当する日付を指定する
   Dim yearVal As Integer: yearVal = 2025
   Dim monthVal As Integer: monthVal = 4
   
   Dim startDate As Date: startDate = DateSerial(yearVal, monthVal, 1)
   Dim endDate As Date: endDate = DateSerial(yearVal, monthVal + 1, 0)
   
   ' 出力先シートを指定
   Dim weekdaySheet As Worksheet: Set weekdaySheet = Worksheets("平日合計")
   Dim holidaySheet As Worksheet: Set holidaySheet = Worksheets("土日祝合計")
   
   ' 合計範囲を指定する
   Dim startCell As String: startCell = "A1"
   Dim endCell As String: endCell = "C3"
   
   ' 範囲を取得してループする
   Dim cellRange As Range
   Set cellRange = Range(startCell & ":" & endCell)
   
   Dim rowOffset As Long, colOffset As Long
   Dim currentDate As Date
   Dim sheetName As String
   Dim wd As Integer
   Dim isHoliday As Boolean
   Dim weekdayFormula As String, holidayFormula As String
   Dim cellAddr As String
   
   For rowOffset = 1 To cellRange.Rows.Count
       For colOffset = 1 To cellRange.Columns.Count
           
           ' 初期化
           weekdayFormula = "="
           holidayFormula = "="
           
           For currentDate = startDate To endDate
               sheetName = Format(currentDate, "yyyymmdd")
               wd = Weekday(currentDate, vbSunday)
               isHoliday = holidayDict.exists(sheetName)
               
               ' 計算式に加えるセル名を定義
               cellAddr = cellRange.Cells(rowOffset, colOffset).Address(False, False)
               
               If isHoliday Or wd = vbSaturday Or wd = vbSunday Then
                   If Len(holidayFormula) > 1 Then holidayFormula = holidayFormula & "+"
                   holidayFormula = holidayFormula & "'" & sheetName & "'!" & cellAddr
               Else
                   If Len(weekdayFormula) > 1 Then weekdayFormula = weekdayFormula & "+"
                   weekdayFormula = weekdayFormula & "'" & sheetName & "'!" & cellAddr
               End If
           Next currentDate
           
           ' 数式として出力
           If Len(weekdayFormula) > 1 Then
               weekdaySheet.Cells(cellRange.Row + rowOffset - 1, cellRange.Column + colOffset - 1).Formula = weekdayFormula
           End If
           
           If Len(holidayFormula) > 1 Then
               holidaySheet.Cells(cellRange.Row + rowOffset - 1, cellRange.Column + colOffset - 1).Formula = holidayFormula              
           End If
               
       Next colOffset
   Next rowOffset
               
End Sub

3-1：合計するセル範囲を指定する

   Dim startCell As String: startCell = "A1"
   Dim endCell As String: endCell = "C3"

今回はA1からC3の範囲を指定。

3-2：範囲を取得してループする

3-2-1：変数を定義

   Dim cellRange As Range
   Set cellRange = Range(startCell & ":" & endCell)
   
   Dim rowOffset As Long, colOffset As Long
   Dim currentDate As Date
   Dim sheetName As String
   Dim wd As Integer
   Dim isHoliday As Boolean
   Dim weekdayFormula As String, holidayFormula As String
   Dim cellAddr As String

cellRang → 処理対象のセル範囲を表すオブジェクト変数
rowOffset,colOffset → 処理中のセルが処理範囲の中で何行目。何列目にあたるかを表す変数。
cellAddr → forループの対象セルのアドレスを格納する変数

3-2-2：forループ処理

   For rowOffset = 1 To cellRange.Rows.Count
       For colOffset = 1 To cellRange.Columns.Count

1から範囲の行数・列数までループしていく。
※セルアドレス等は処理内で明記する。

3-2-3：初期化

           weekdayFormula = "="
           holidayFormula = "="

ループごとに式作成用の変数を初期化する。

3-2-4：セルごとに月初めから月末まで繰り返す。

           For currentDate = startDate To endDate
               ///
           Next currentDate

3-2-5：処理するセルを特定

    cellAddr = cellRange.Cells(rowOffset, colOffset).Address(False, False)

指定された範囲(cellRange)の中から特定の行・列のセルを選び格納する。

3-2-6：数式として出力

If Len(weekdayFormula) > 1 Then
    weekdaySheet.Cells(cellRange.Row + rowOffset - 1, cellRange.Column + colOffset - 1).Formula = weekdayFormula
End If
           
If Len(holidayFormula) > 1 Then
    holidaySheet.Cells(cellRange.Row + rowOffset - 1, cellRange.Column + colOffset - 1).Formula = holidayFormula          
End If

cellRange.Row → 処理範囲の初めの行（例：A1：C3が処理範囲なら "1" ）
cellRange.Column → 処理範囲の初めの列（例：A1：C3が処理範囲なら "1" ）

3-3：まとめ

以上より複数範囲に対応した処理を作成することができた。
他の処理と組み合わせることで実用的なものになるのかもしれない。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?