Excel VBA | 「Cells × Range × Offset × Resize × CurrentRegion × SpecialCells × Find × AutoFilter × Sort × Subtotal × PivotTable」応用テンプレ集

VBA

2025.11.26

ここまでの組み合わせに PivotTable（ピボットテーブル） を加えると、検索・抽出・加工・フィルタリング・並べ替え・集計・分析まで一気通貫で扱えるようになります。
実務で役立つ応用テンプレを整理しました。

基本操作（PivotTable）
Find × PivotTable
AutoFilter × PivotTable
Sort × PivotTable
Subtotal × PivotTable
Offset × Resize × PivotTable
SpecialCells × PivotTable
高度な応用
実務での使い分けポイント

基本操作（PivotTable）

表全体からピボットテーブルを作成

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tbl).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot1"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tbl).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot1"

フィールドを追加

With ActiveSheet.PivotTables("Pivot1")
    .PivotFields("都道府県").Orientation = xlRowField
    .PivotFields("市区町村").Orientation = xlColumnField
    .PivotFields("売上").Orientation = xlDataField
    .PivotFields("売上").Function = xlSum
End With

With ActiveSheet.PivotTables("Pivot1")
    .PivotFields("都道府県").Orientation = xlRowField
    .PivotFields("市区町村").Orientation = xlColumnField
    .PivotFields("売上").Orientation = xlDataField
    .PivotFields("売上").Function = xlSum
End With

Find × PivotTable

検索結果列をピボットの行フィールドに設定

Dim tbl As Range, f As Range
Set tbl = Range("A1").CurrentRegion
Set f = tbl.Find("都道府県")
If Not f Is Nothing Then
    ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot2"
    With ActiveSheet.PivotTables("Pivot2")
        .PivotFields(f.Value).Orientation = xlRowField
    End With
End If

Dim tbl As Range, f As Range
Set tbl = Range("A1").CurrentRegion
Set f = tbl.Find("都道府県")
If Not f Is Nothing Then
    ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot2"
    With ActiveSheet.PivotTables("Pivot2")
        .PivotFields(f.Value).Orientation = xlRowField
    End With
End If

AutoFilter × PivotTable

フィルタ後のデータをピボットに反映

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.AutoFilter Field:=2, Criteria1:="東京都"
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeVisible)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_Filtered"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.AutoFilter Field:=2, Criteria1:="東京都"
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeVisible)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_Filtered"

Sort × PivotTable

並べ替え後のデータをピボットに反映

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Sort Key1:=tbl.Columns(2), Order1:=xlAscending, Header:=xlYes
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot_Sorted"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Sort Key1:=tbl.Columns(2), Order1:=xlAscending, Header:=xlYes
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot_Sorted"

Subtotal × PivotTable

小計を追加した表をピボットに反映

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), Replace:=True
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot_Subtotal"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), Replace:=True
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot_Subtotal"

Offset × Resize × PivotTable

表の右隣にコピーしてピボット作成

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Offset(0, tbl.Columns.Count + 1).Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.Offset(0, tbl.Columns.Count + 1).Resize(tbl.Rows.Count, tbl.Columns.Count)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_CopyRight"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Offset(0, tbl.Columns.Count + 1).Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.Offset(0, tbl.Columns.Count + 1).Resize(tbl.Rows.Count, tbl.Columns.Count)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_CopyRight"

表の下にコピーしてピボット作成

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Offset(tbl.Rows.Count + 2, 0).Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.Offset(tbl.Rows.Count + 2, 0).Resize(tbl.Rows.Count, tbl.Columns.Count)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_CopyDown"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Offset(tbl.Rows.Count + 2, 0).Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.Offset(tbl.Rows.Count + 2, 0).Resize(tbl.Rows.Count, tbl.Columns.Count)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_CopyDown"

SpecialCells × PivotTable

定数セルだけをピボットに反映

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
On Error Resume Next
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeConstants)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_Constants"
On Error GoTo 0

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
On Error Resume Next
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeConstants)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_Constants"
On Error GoTo 0

数式セルだけをピボットに反映

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
On Error Resume Next
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeFormulas)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_Formulas"
On Error GoTo 0

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
On Error Resume Next
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeFormulas)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_Formulas"
On Error GoTo 0

高度な応用

検索＋フィルタ＋並べ替え＋小計＋ピボット

Dim tbl As Range, f As Range
Set tbl = Range("A1").CurrentRegion
Set f = tbl.Find("都道府県")
If Not f Is Nothing Then
    tbl.AutoFilter Field:=f.Column - tbl.Column + 1, Criteria1:="東京都"
    tbl.Sort Key1:=f, Order1:=xlAscending, Header:=xlYes
    tbl.Subtotal GroupBy:=f.Column - tbl.Column + 1, Function:=xlSum, TotalList:=Array(f.Column + 1), Replace:=True
    ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeVisible)).CreatePivotTable _
        TableDestination:="Sheet2!R1C1", TableName:="Pivot_Advanced"
End If

Dim tbl As Range, f As Range
Set tbl = Range("A1").CurrentRegion
Set f = tbl.Find("都道府県")
If Not f Is Nothing Then
    tbl.AutoFilter Field:=f.Column - tbl.Column + 1, Criteria1:="東京都"
    tbl.Sort Key1:=f, Order1:=xlAscending, Header:=xlYes
    tbl.Subtotal GroupBy:=f.Column - tbl.Column + 1, Function:=xlSum, TotalList:=Array(f.Column + 1), Replace:=True
    ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.SpecialCells(xlCellTypeVisible)).CreatePivotTable _
        TableDestination:="Sheet2!R1C1", TableName:="Pivot_Advanced"
End If

フィルタ後の可視セルを右隣にコピー＋ピボット

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.AutoFilter Field:=2, Criteria1:="東京都"
tbl.SpecialCells(xlCellTypeVisible).Copy Destination:=tbl.Offset(0, tbl.Columns.Count + 2).Cells(1, 1)
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.Offset(0, tbl.Columns.Count + 2).Resize(tbl.Rows.Count, tbl.Columns.Count)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_FilterCopy"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.AutoFilter Field:=2, Criteria1:="東京都"
tbl.SpecialCells(xlCellTypeVisible).Copy Destination:=tbl.Offset(0, tbl.Columns.Count + 2).Cells(1, 1)
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl.Offset(0, tbl.Columns.Count + 2).Resize(tbl.Rows.Count, tbl.Columns.Count)).CreatePivotTable _
    TableDestination:="Sheet2!R1C1", TableName:="Pivot_FilterCopy"

表の下に合計行を追加＋ピボット

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Offset(tbl.Rows.Count, 0).Resize(1, tbl.Columns.Count).Value = "合計行"
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot_TotalRow"

Dim tbl As Range
Set tbl = Range("A1").CurrentRegion
tbl.Offset(tbl.Rows.Count, 0).Resize(1, tbl.Columns.Count).Value = "合計行"
ActiveWorkbook.PivotCaches.Create(xlDatabase, tbl).CreatePivotTable "Sheet2!R1C1", "Pivot_TotalRow"

実務での使い分けポイント

表全体 → CurrentRegion
検索 → Find
隣接セル操作 → Offset
範囲拡張 → Resize
特定セル抽出 → SpecialCells
フィルタリング → AutoFilter
並べ替え → Sort
集計 → Subtotal
分析・クロス集計 → PivotTable

💡 この「Cells × Range × Offset × Resize × CurrentRegion × SpecialCells × Find × AutoFilter × Sort × Subtotal × PivotTable」テンプレを押さえておけば、表全体の動的検索・抽出・加工・フィルタリング・並べ替え・集計・分析まで自在に扱えます。