![見出し画像](https://assets.st-note.com/production/uploads/images/87638210/rectangle_large_type_2_234361705af614031fae926467c0a715.png?width=1200)
「シート集約マクロ」のレシピ
「1つのExcelで複数シート管理」
日常使いでは苦労する場面がありませんか?
1つのExcelブックで複数のシートを管理する。
こんな使い方をされている方も少なくないはずです。
Excelブックの数が減る分、ドキュメント管理は簡単になるかもですが、
日常使いでは、少し苦労する場面があるのではないでしょうか。
例えば、
ブック全体のデータを集計・分析したいとき
中身を整理したいとき などなど
複数シートを使うことで、日常使い、とりわけ見栄えが良くなりますが
いざ、データを集計する際に、整理の段階で四苦八苦する羽目に…
ショートカットキーを駆使して、切り貼り作業で時間が溶ける。
わたし自身、こんな経験が結構ありました。笑
今回はそんなときに使える、とっておきのExcelマクロ
「シートを自動集約するマクロ」をご紹介します!
1.マクロの説明と使い方
Excelマクロで、ブック内の複数シートを1つのシートに集約するよ。
集計とかデータ整理したいときに、1つの表データとした方が、作業が進めやすいと。是非、使ってみてね!
![](https://assets.st-note.com/img/1664105275620-ADbST9LgeX.png?width=1200)
これを例にすると、日付毎のシートにあるデータを先頭のシートにひと纏めにするマクロだよ。
2.マクロを使うための手順
シート集約マクロを使うための手順を整理するよ。
ソースコードは最後にまとめてるから、参考にしてね!
マクロのソースコードを標準モジュールにコピペ
複数シートの体裁(フォーマット)を整える
マクロを使う 名前丨combSheetsData
1.マクロのソースコードを標準モジュールにコピペ
> 開発タブ > Visual Basic > 標準モジュール > ソースをコピペ
![](https://assets.st-note.com/img/1664106102046-9MLuZWBXCP.png?width=1200)
2.複数シートの体裁(フォーマット)を整える
各シートの体裁を統一しておく必要があるよ。
例えば、どのシートでもB列 = 品目名 で整理しておく
![](https://assets.st-note.com/img/1664106168127-cL6pD5MXP9.png?width=1200)
3.マクロを使う マクロ名丨combSheetsData
> 開発タブ > マクロ > マクロ名丨combSheetsData > 実行
![](https://assets.st-note.com/img/1664106213513-JEaHY693IB.png?width=1200)
3.マクロを使うときの注意点
マクロを使う際は、以下のことに注意してください。
マクロの実装および実行はすべて自己責任で行ってください。
開発環境は、Windows OS 64bit が対象になります。
マクロには特定のシートを作成・削除するコードが含まれています。
参照元シートの先頭見出しは、セルA1である必要があります。
参照元シートの体裁は整えて置く必要があります。
集計データには、参照元の各シート名を追加します。
4.Excel VBAのソースコード
Option Explicit
Sub CombSheetsData()
'--------------------------------
' findMe: ブック内のシートデータを結合する
' name: テラ|RPA×静かな退職
' instagram: @tera.rpaer
'--------------------------------
' cau: マクロの実装及び実行はすべて自己責任でお願いします。
' cau: 各シートのフォーマットは統一する必要があります。
' cau: only WindowsOS Excel 64bit
'--------------------------------
Const shName = "集計データです byテラ"
Dim wsList As Worksheet: Set wsList = AddSh(shName)
Dim wsSearch As Worksheet
Dim arrList As Variant
Dim mRow As Long: mRow = 1
Dim isTitle As Long: isTitle = 0
With wsList
.Activate
For Each wsSearch In Worksheets
If Not wsSearch.Name Like shName Then
Application.DisplayAlerts = False
arrList = getArr2D(wsSearch.Name, isTitle)
If isTitle = 0 Then isTitle = 1
.Range(Cells(mRow, 2), Cells(mRow + UBound(arrList, 1) - 1, 1 + UBound(arrList, 2))) = arrList
.Range(Cells(mRow, 1), Cells(mRow + UBound(arrList, 1) - 1, 1)) = wsSearch.Name
mRow = .Cells(Rows.Count, 2).End(xlUp).Row + 1
Application.DisplayAlerts = True
End If
Next wsSearch
.Range("A1") = "シート名"
End With
End Sub
Function getArr2D(shName As String, shOffset As Long) As Variant
'--------------------------------
' findMe: 対象シートのデータを二次元配列で返す
' name: テラ|RPA×静かな退職
' instagram: @tera.praer
'--------------------------------
' in1: shName|データがあるシートの名前
' in2: shOffset|削除範囲を行数で指定
'--------------------------------
Dim tera As Variant
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(shName)
With ws.Range("A1").CurrentRegion
tera = .Offset(shOffset).Resize(.Rows.Count - shOffset)
End With
getArr2D = tera
End Function
Sub ClearSh(shName As String)
'--------------------------------
' findMe: 対象シートを削除する
' name: テラ|RPA×静かな退職
' instagram: @tera.rpaer
'--------------------------------
' in1: shName|削除するシートの名前
'--------------------------------
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name Like shName Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
Function AddSh(shName As String) As Worksheet
'--------------------------------
' findMe: 対象シートを作成する
' name: テラ|RPA×静かな退職
' instagram: @tera.rpaer
'--------------------------------
' in1: shName|追加するシートの名前
'--------------------------------
' out: Worksheet|追加したシート
'--------------------------------
ClearSh (shName)
Dim ws As Worksheet
Set ws = Worksheets.Add
ws.Name = shName
Set AddSh = ws
End Function
'-------------------------------------------
' □□□□□□□□□□□□□ @tera.rpaer
' □□■■■□□□■■■□□ テラ|RPA×静かな退職
' □■□□□■□■□□□■□ 1万人企業の社内SEで自動化オタク
' □■□□□■■■□□□■□ 業務自動化ツールのアイデアを発信
' □■□□□■□■□□□■□ ソースコードはキャプションにて
' □□■■■□□□■■■□□ 一児のパパ|可愛い嫁|オタク
' □□□□□□□□□□□□□ お問合せはDM・コメントでどうそ
'-------------------------------------------
このアカウントでは、
Excel VBA やRPAツールを使用した
パソコン業務の時短術・自動化術を紹介します。
この投稿が、
ま〜ま〜ええやん。と思っていただけましたら
ぜひ、「いいね」「フォロー」してもらえると励みになります:)
投稿内容に質問・指摘などありましたら、
お気軽にDM・コメントでどうぞ!!
Follow me ! ▷ @tera.rpaer
この記事が気に入ったらサポートをしてみませんか?