EXCEL VBA 指定した行列に小計を追加する。Subtotal関数または、配列を駆使して効率的な集計を行う方法

EXCEL VBA 指定した行列に小計を追加する。Subtotal関数または、配列を駆使して効率的な集計を行う方法

EXCEL VBA 指定した列に小計を追加する。Subtotal関数を駆使して効率的な集計を行う方法。Excel列の小計計算を自動化する方法

'
'
Option Explicit


Sub AddSubTotal() '列に小計を挿入する。

    Dim ws As Worksheet
    Dim lastRow As Long

    ' Worksheetの設定
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Subtotal関数を使って小計を計算し、列に挿入
    InsertColumnAndCalculate ws, 4, 2, 3, lastRow
    InsertColumnAndCalculate ws, 8, 5, 7, lastRow

End Sub

Sub InsertColumnAndCalculate(ByRef ws As Worksheet, ByVal insertColumn As Long, ByVal startColumn As Long, ByVal endColumn As Long, ByVal lastRow As Long)

    ' 列を挿入
    ws.Columns(insertColumn).Insert
    
    ' 小計のセルにSubtotal関数を入れて計算
    ws.Range(ws.Cells(2, insertColumn), ws.Cells(lastRow, insertColumn)).FormulaR1C1 = "=SUBTOTAL(9,RC[" & (startColumn - insertColumn) & "]:RC[" & (endColumn - insertColumn) & "])"

    ' 小計列の見出しを設定
    ws.Cells(1, insertColumn) = "小計"
    
    ' 集計行の背景色を薄い水色にする
    ws.Range(ws.Cells(1, insertColumn), ws.Cells(lastRow, insertColumn)).Interior.Color = RGB(173, 216, 230)
    
    ' 罫線を引く
    With ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, insertColumn)).Borders
        .LineStyle = xlContinuous
        .Color = RGB(0, 0, 0)
        .Weight = xlThin
    End With

End Sub

'
'

EXCEL VBA 指定した行に小計を追加する。Subtotal関数を駆使して効率的な集計！自動小計挿入！

EXCEL VBA 列の小計を自動計算する方法。配列を駆使して効率的な集計を行う。

Option Explicit

'
'
Sub AddSubTotal()  '列小計を配列

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim dataArr As Variant
    Dim sumResult As Double
    Dim i As Long, j As Long

    ' Worksheetの設定
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' 列を挿入し、配列を用いて計算
    InsertColumnAndCalculate ws, 4, 2, 3, lastRow
    
    InsertColumnAndCalculate ws, 9, 5, 8, lastRow

End Sub

'
'
Sub InsertColumnAndCalculate(ByRef ws As Worksheet, ByVal insertColumn As Long, ByVal startColumn As Long, ByVal endColumn As Long, ByVal lastRow As Long)

    Dim dataRange As Range
    Dim dataArr As Variant
    Dim sumResult As Double
    Dim i As Long, j As Long

    ' 列を挿入
    ws.Columns(insertColumn).Insert

    ' 指定された範囲のデータを配列に読み込む
    Set dataRange = ws.Range(ws.Cells(2, startColumn), ws.Cells(lastRow, endColumn))
    dataArr = dataRange.Value

    ' 配列内のデータを行ごとに加算
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        sumResult = 0
        For j = LBound(dataArr, 2) To UBound(dataArr, 2)
            sumResult = sumResult + dataArr(i, j)
        Next j
        ' 計算結果を新たな列に書き込む
        ws.Cells(i + 1, insertColumn).Value = sumResult
    Next i

    ws.Cells(1, insertColumn) = "小計"
       ' 集計行の背景色を薄い水色にする
    ws.Range(ws.Cells(1, insertColumn), ws.Cells(lastRow, insertColumn)).Interior.Color = RGB(173, 216, 230)
        ' 罫線を引く
    With ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, insertColumn)).Borders
        .LineStyle = xlContinuous
        .Color = RGB(0, 0, 0)
        .Weight = xlThin
    End With

End Sub
'
'

EXCEL VBA 行を自動挿入し、データを集計するVBAコード！配列を駆使して効率的な集計！

Option Explicit
'
'
Sub AddSubTotal() '小計行を追加

    Dim ws As Worksheet
    Dim lastColumn As Long
    Dim dataRange As Range
    Dim dataArr As Variant
    Dim sumResult As Double
    Dim i As Long, j As Long

    ' Worksheetの設定
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 最終列を取得
    lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' 行を挿入し、配列を用いて計算
    InsertRowAndCalculate ws, 9, 2, 8, lastColumn
    
    InsertRowAndCalculate ws, 17, 10, 16, lastColumn
    
End Sub
'
'
Sub InsertRowAndCalculate(ByRef ws As Worksheet, ByVal insertRow As Long, ByVal StartRow As Long, ByVal EndRow As Long, ByVal lastColumn As Long)

    Dim dataRange As Range
    Dim dataArr As Variant
    Dim sumResult As Double
    Dim i As Long, j As Long

    ' 行を挿入
    ws.Rows(insertRow).Insert

    ' 指定された範囲のデータを配列に読み込む
    Set dataRange = ws.Range(ws.Cells(StartRow, 2), ws.Cells(EndRow, lastColumn))
    dataArr = dataRange.Value

    ' 配列内のデータを列ごとに加算
    For j = LBound(dataArr, 2) To UBound(dataArr, 2)
        sumResult = 0
        For i = LBound(dataArr, 1) To UBound(dataArr, 1)
            sumResult = sumResult + dataArr(i, j)
        Next i
        ' 計算結果を新たな行に書き込む
        ws.Cells(insertRow, j + 1).Value = sumResult
    Next j
    
    ws.Cells(insertRow, "A") = "小計"
       ' 集計行の背景色を薄い水色にする
    ws.Range(ws.Cells(insertRow, 1), ws.Cells(insertRow, lastColumn)).Interior.Color = RGB(173, 216, 230)

End Sub

'