【VBA】テーブル内のセルに数式を設定する

# 目次
- [概要](#概要)
- [通常のセルに数式を追加する場合](#通常のセルに数式を追加する場合)
- [テーブルに数式を含む行を追加する場合](#テーブルに数式を含む行を追加する場合)
- [原因](#原因)
- [対処法](#対処法)
- [汎用化](#汎用化)
- [まとめ](#まとめ)

# 概要
VBAで```Formula```を利用し、セルに数式を追加しようとしたときに引っかかったExcelの仕様についての話。

# 通常のセルに数式を追加する場合
以下のコードのように記述すれば、セルに数式を追加できる。

```vb:通常のセルに数式を追加
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
```

|　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　|
|:-:|
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3628912/30d31c2a-a867-482f-bb98-221e9d43d27d.png)
<font color="gray">挿入された数式</font>

# テーブルに数式を含む行を追加する場合
```vb:テーブルに数式を含む行を追加
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
```

このコードを実行すると、以下のように想定とは異なる数式が挿入されてしまう。
|　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　|
|:-:|
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3628912/809e787d-7116-4fb8-b8b7-5ee9af41a297.png)
<font color="gray">挿入された数式</font>

# 原因
調査したところ、テーブルのオートフィル機能が働くためにこのようなことが起こるらしい。

<iframe width="560" height="315" src="https://www.youtube.com/embed/6-TKbzvBRp0?si=v4iYIq8TWIC-xqxK" title="YouTube video player" frameborder="0" allow="accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture; web-share" referrerpolicy="strict-origin-when-cross-origin" allowfullscreen></iframe>

1行だけ追加した段階では想定通りの数式が挿入されているが、2行目を追加したときオートフィルが働き、想定とは異なる数式になっている。

# 対処法
[ChatGPT](https://chatgpt.com/)とともに試行錯誤したところ、以下の手順でうまくいくことがわかった。
1. 一度テーブルの状態を解除する
2. 数式（を含む行）を追加する
3. 再びテーブル化する

```vb:対処後のコード
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
```
|　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　|
|:-:|
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3628912/f8f15eb2-f29c-4bdc-b1ee-124fc89d5e45.png)
<font color="gray">挿入された数式</font>

# 汎用化
より汎用的に使えるようにしたものも、ChatGPTと一緒に考えてみた。

```vb:汎用化
' テーブルの解除、データ追加、再テーブル化を汎用化
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を利用する際は、基本的にテーブル化しないほうがよさそう。