目次
概要
VBAでFormulaを利用し、セルに数式を追加しようとしたときに引っかかったExcelの仕様についての話。
通常のセルに数式を追加する場合
以下のコードのように記述すれば、セルに数式を追加できる。
通常のセルに数式を追加
Public Sub test1()
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
For i = 1 To 5
' 1行目だけ異なる数式を挿入
If i = 1 Then
ws.Cells(i, 1).Formula = "=D3"
Else
ws.Cells(i, 1).Formula = "=MAX(F3:G3)"
End If
Next i
End Sub
 |
| 挿入された数式 |
テーブルに数式を含む行を追加する場合
テーブルに数式を含む行を追加
Public Sub test2()
Dim table As ListObject
Dim i As Long
Dim newRow As ListRow
' テーブルの取得
Set table = ThisWorkbook.Sheets("Sheet2").ListObjects("テーブル2")
For i = 1 To 5
' 新しい行を追加
Set newRow = table.ListRows.Add
' 1行目だけ異なる数式を挿入
If i = 1 Then
newRow.Range(2).Formula = "=D3"
Else
newRow.Range(2).Formula = "=MAX(F3:G3)"
End If
Next i
End Sub
このコードを実行すると、以下のように想定とは異なる数式が挿入されてしまう。
 |
| 挿入された数式 |
原因
調査したところ、テーブルのオートフィル機能が働くためにこのようなことが起こるらしい。
1行だけ追加した段階では想定通りの数式が挿入されているが、2行目を追加したときオートフィルが働き、想定とは異なる数式になっている。
対処法
ChatGPTとともに試行錯誤したところ、以下の手順でうまくいくことがわかった。
- 一度テーブルの状態を解除する
- 数式（を含む行）を追加する
- 再びテーブル化する
対処後のコード
Sub test3()
Dim ws As Worksheet
Dim tbl As ListObject
Dim rng As Range
Dim tblName As String
Dim tblStyle As String
Dim headerRow As Range
Dim dataRange As Range
Dim lastCol As Long
Dim i As Long
Set ws = ThisWorkbook.Sheets("Sheet3")
Set tbl = ws.ListObjects("テーブル3")
tblName = tbl.Name
tblStyle = tbl.TableStyle
' テーブルの全体範囲を保存
Set rng = tbl.Range
Set headerRow = rng.Rows(1)
' 数式をB列の最後の行にだけ入れる（例：=D3）
Dim lastRow As Long
If tbl.ListRows Is Nothing Then
lastRow = headerRow.Row
ElseIf tbl.ListRows.Count = 0 Then
lastRow = headerRow.Row
Else
lastRow = tbl.ListRows(tbl.ListRows.Count).Range.Row
End If
' テーブル解除（通常の範囲にする）
tbl.Unlist
' 数式の追加
For i = 1 To 5
If i = 1 Then
ws.Cells(lastRow + 1, 2).Formula = "=D2"
Else
ws.Cells(lastRow + i, 2).Formula = "=MAX(F3:G3)"
End If
Next i
' 元の範囲を再びテーブルとして戻す
Set dataRange = ws.Range(headerRow, ws.Cells(lastRow + 5, rng.Columns.Count))
With ws.ListObjects.Add(xlSrcRange, dataRange, , xlYes)
.Name = tblName
.TableStyle = tblStyle
End With
End Sub
 |
| 挿入された数式 |
汎用化
より汎用的に使えるようにしたものも、ChatGPTと一緒に考えてみた。
汎用化
' テーブルの解除、データ追加、再テーブル化を汎用化
Public Sub UpdateTableWithFormulas( _
ByVal sheetName As String, _
ByVal tableName As String, _
ByVal formulaGenerator As Variant, _
Optional ByVal insertRows As Long = 5 _
)
Dim ws As Worksheet
Dim tbl As ListObject
Dim rng As Range
Dim tblStyle As String
Dim tblName As String
Dim headerRow As Range
Dim dataRange As Range
Dim lastRow As Long
Dim i As Long
Set ws = ThisWorkbook.Sheets(sheetName)
Set tbl = ws.ListObjects(tableName)
tblName = tbl.Name
tblStyle = tbl.TableStyle
Set rng = tbl.Range
Set headerRow = rng.Rows(1)
' 最終行（シート上の行番号）を取得
If tbl.ListRows.Count = 0 Then
lastRow = headerRow.Row
Else
lastRow = tbl.ListRows(tbl.ListRows.Count).Range.Row
End If
' テーブルを解除
tbl.Unlist
' 行を追加して、1セルずつ数式を設定
For i = 1 To insertRows
Dim formula As String
formula = Application.Run(formulaGenerator, i, lastRow)
ws.Cells(lastRow + i, 2).Formula = formula
Next i
' テーブルを復元
Set dataRange = ws.Range(headerRow, ws.Cells(lastRow + insertRows, rng.Columns.Count))
With ws.ListObjects.Add(xlSrcRange, dataRange, , xlYes)
.Name = tblName
.TableStyle = tblStyle
End With
End Sub
' 数式を追加する処理
Public Function MyFormulaGenerator(ByVal i As Long, ByVal lastRow As Long) As String
If i = 1 Then
MyFormulaGenerator = "=D2"
Else
MyFormulaGenerator = "=MAX(F3:G3)"
End If
End Function
' 実際に動かす
Public Sub test4()
Call UpdateTableWithFormulas("Sheet4", "テーブル4", "MyFormulaGenerator", 5)
End Sub
まとめ
意外と厄介な仕様だと感じた。
Formulaを利用する際は、基本的にテーブル化しないほうがよさそう。