EXCEL VBA 複数セルを範囲選択し選択範囲からデータを集計・別シートに作成（テクニック・業務効率化）

2021年11月13日

EXCEL VBA 複数セルを範囲選択し、その選択範囲からデータを集計（テクニック・業務効率化）

●はじめに

今回説明するのは、連続した複数のセル範囲を選択し、その選択範囲を元にデータを集計するサンプルプログラムです。頻繁に選択範囲を変えて集計する場合は、直接セル範囲を変えるなどプログラムを変更する必要があります。プログラムを直接変更する事なく、セルを選択した範囲を元に集計ができると、様々な集計範囲からデータを集計する事ができるので、データの分析等にも利用する事ができます。それでは、サンプルプログラムを交えて順番に説明いたします。

●【EXCEL VBA 連想配列で選択範囲を集計・別シートに取り出しについては、下記を参照して下さい】

EXCEL VBA 連想配列で選択範囲を集計・別シートに取り出し・自由に選択した範囲を集計（テクニック）

EXCEL VBA 複数セルを範囲選択して、その選択範囲からデータを集計、結果を別シートに表示

●プログラム説明　（サンプル①）

下記のサンプルプログラムは、複数セルを範囲選択して、その選択した範囲からデータを集計し、結果を別シートに表示するサンプルプログラムです。頻繁に選択範囲を変更して集計結果が得られるのでとても便利だと思います。

【実行手順】

【プログラムの流れ】

【注意点】
・データの選択範囲は、連続範囲（行）のみ集計されます。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　cells_selection（サンプルプログラム）

'
'
Sub 選択範囲集計() '別シート転記

    
    Dim ws01, ws02, ws03, ws04, ws05 As Worksheet
    Dim I, l, HaniTOP, HaniDown, lRow, mRow, Y As Long
    
    Set ws01 = Worksheets("データ")
    Set ws02 = Worksheets("売上日報")
    Set ws03 = Worksheets("集計")
    Set ws04 = Worksheets("ひな形")
    Set ws05 = Worksheets("Work")
    
    '--------------------------範囲選択から貼り付け
    
    HaniTOP = Selection(1).Row '選択範囲の先頭行を把握します。
    HaniDown = Selection(Selection.Count).Row  '選択範囲の最終行を把握します。
    
    lRow = ws03.Cells(Rows.Count, "A").End(xlUp).Row
    ws03.Range("A2:H" & lRow + 1).ClearContents      'ワークシート「集計」を文字列クリアーします。
    lRow = ws05.Cells(Rows.Count, "A").End(xlUp).Row
    ws05.Range("A2:H" & lRow + 1).ClearContents      'ワークシート「Work」を文字列クリアーします。

    ws01.Range("A" & HaniTOP & ":H" & HaniDown).Copy  'ワークシート「データ」選択範囲のA列～H列をワークシート「Work」へデータを貼り付けます。
    ws05.Range("A2").PasteSpecial xlPasteValues 'データの値貼り付けします。
    
    ws01.Range("B" & HaniTOP & ":C" & HaniDown).Copy  'ワークシート「データ」選択範囲のB列～C列をワークシート「集計」へデータを貼り付けます。
    ws03.Range("A2").PasteSpecial xlPasteValues 'データの値貼り付けします。

    '----------------------------重複削除
    
    lRow = ws03.Cells(Rows.Count, "A").End(xlUp).Row  'ワークシート「集計」A列の最終行を把握します。（シート「データ」⇒「集計」に貼り付けたデータ件数を把握）
    ws03.Range("A1:B" & lRow).RemoveDuplicates Columns:=2, Header:=xlYes  'ワークシート「集計」に貼り付けたデータB列「店名」に対して重複削除します。
    
    '----------------------------集計処理
    
    lRow = ws05.Cells(Rows.Count, "A").End(xlUp).Row  'ワークシート「Work」A列の最終行を把握します。
    
    mRow = ws03.Cells(Rows.Count, "A").End(xlUp).Row  'ワークシート「集計」A列の最終行を把握します。
    
    For I = 2 To mRow  'ワークシート「集計」の最終行（データ）まで繰り返します。
        ws03.Cells(I, "C").FormulaArray = "=SUM(IF(Work!C2:C" & lRow & "=B" & I & ",Work!D2:D" & lRow & "))" 'ワークシート「Work」を元に「商品A」のデータを集計し、ワークシート「集計」へ計算式を記入します。
        ws03.Cells(I, "D").FormulaArray = "=SUM(IF(Work!C2:C" & lRow & "=B" & I & ",Work!E2:E" & lRow & "))" '　　　　　　　　　　　　　「商品B」　　　〃
        ws03.Cells(I, "E").FormulaArray = "=SUM(IF(Work!C2:C" & lRow & "=B" & I & ",Work!F2:F" & lRow & "))" '　　　　　　　　　　　　　「商品C」　　　〃
        ws03.Cells(I, "F").FormulaArray = "=SUM(IF(Work!C2:C" & lRow & "=B" & I & ",Work!G2:G" & lRow & "))" '　　　　　　　　　　　　　「商品D」　　　〃
        ws03.Cells(I, "G").FormulaArray = "=SUM(IF(Work!C2:C" & lRow & "=B" & I & ",Work!H2:H" & lRow & "))" '　　　　　　　　　　　　　「客数」　　　 〃
    Next I
    
    '----------------------------転記処理
    
    Y = 1
    
    Application.DisplayAlerts = False  '警告メッセージを無効化します。
    
    ws02.Cells.Clear  'ワークシート「売上日報」をクリアー（全て削除します。）
    
    For I = 2 To mRow  '店名分繰り返す。（ひな形よりコピー⇒集計データを転記）
    
        ws04.Range("A1:T15").Copy  'ワークシート「ひな形」セル（A1：T15）を選択（コピー）
        ws02.Range("A" & Y).PasteSpecial xlPasteAll  'ワークシート「売上日報」へ「ひな形」を貼り付けます。
        
        ws02.Range("J" & Y + 6) = ws03.Cells(I, "C")   'ワークシート「集計」の「商品A」のデータをワークシート「売上日報」へ転記します。
        ws02.Range("J" & Y + 7) = ws03.Cells(I, "D")   '　　　　　　　　　　　　商品B          〃
        ws02.Range("J" & Y + 8) = ws03.Cells(I, "E")   '　　　　　　　　　　　　商品C　　　　　〃
        ws02.Range("J" & Y + 9) = ws03.Cells(I, "F")   '　　　　　　　　　　　　商品D　　　　　〃
      
        ws02.Range("A" & Y + 5) = ws03.Cells(I, "A") '　　　　　　　　　　　　　店番号　　　　〃
        ws02.Range("C" & Y + 5) = ws03.Cells(I, "B") '　　　　　　　　　　　　　店名　　　　　〃
        ws02.Range("E" & Y + 11) = ws03.Cells(I, "G")  '　　　　　　　　　　　　客数　　　　　〃
        
        ws02.Range("C" & Y + 2) = "=DMIN(Work!A1:C" & lRow & ",Work!A1,売上日報!C" & Y + 4 & ":C" & Y + 5 & ")"  'ワークシート「Work」を元に集計期間（開始）をシート「売上日報」へ記入します。
        ws02.Range("F" & Y + 2) = "=DMAX(Work!A1:C" & lRow & ",Work!A1,売上日報!C" & Y + 4 & ":C" & Y + 5 & ")"  '　　　　　　　　　　　　　　　　　（終了）
        
        Y = Y + 15  '次の店名をデータを転記するために、行位置を加算する。

    Next I
    
     Application.DisplayAlerts = False  '警告メッセージを有効化します。
     
     ws02.Activate 'ワークシート「売上日報」を表示します。

End Sub
'
'

Sub 選択範囲集計() '別シート転記

Dim ws01, ws02, ws03, ws04, ws05 As Worksheet

Dim I, l, HaniTOP, HaniDown, lRow, mRow, Y As Long

Set ws01 = Worksheets("データ")

Set ws02 = Worksheets("売上日報")

Set ws03 = Worksheets("集計")

Set ws04 = Worksheets("ひな形")

Set ws05 = Worksheets("Work")

'--------------------------範囲選択から貼り付け

HaniTOP = Selection(1).Row '選択範囲の先頭行を把握します。

HaniDown = Selection(Selection.Count).Row '選択範囲の最終行を把握します。

lRow = ws03.Cells(Rows.Count, "A").End(xlUp).Row

ws03.Range("A2:H" & lRow + 1).ClearContents 'ワークシート「集計」を文字列クリアーします。

lRow = ws05.Cells(Rows.Count, "A").End(xlUp).Row

ws05.Range("A2:H" & lRow + 1).ClearContents 'ワークシート「Work」を文字列クリアーします。

ws01.Range("A" & HaniTOP & ":H" & HaniDown).Copy 'ワークシート「データ」選択範囲のA列～H列をワークシート「Work」へデータを貼り付けます。

ws05.Range("A2").PasteSpecial xlPasteValues 'データの値貼り付けします。

ws01.Range("B" & HaniTOP & ":C" & HaniDown).Copy 'ワークシート「データ」選択範囲のB列～C列をワークシート「集計」へデータを貼り付けます。

ws03.Range("A2").PasteSpecial xlPasteValues 'データの値貼り付けします。

'----------------------------重複削除

lRow = ws03.Cells(Rows.Count, "A").End(xlUp).Row 'ワークシート「集計」A列の最終行を把握します。（シート「データ」⇒「集計」に貼り付けたデータ件数を把握）

ws03.Range("A1:B" & lRow).RemoveDuplicates Columns:=2, Header:=xlYes 'ワークシート「集計」に貼り付けたデータB列「店名」に対して重複削除します。

'----------------------------集計処理

lRow = ws05.Cells(Rows.Count, "A").End(xlUp).Row 'ワークシート「Work」A列の最終行を把握します。

mRow = ws03.Cells(Rows.Count, "A").End(xlUp).Row 'ワークシート「集計」A列の最終行を把握します。

For I = 2 To mRow 'ワークシート「集計」の最終行（データ）まで繰り返します。

ws03.Cells(I, "C").FormulaArray = "=SUM(IF(Work!C2:C" & lRow & "=B" & I & ",Work!D2:D" & lRow & "))" 'ワークシート「Work」を元に「商品A」のデータを集計し、ワークシート「集計」へ計算式を記入します。