KE2

関数を自作したけど自動で更新されない…
そのようなことがあるかと思います。

基本は、関数は関数自身に関係のあるセルが変更された際に、再計算されます。

例えば、下記の関数の場合はセルA1が変更された場合に関してのみ更新されます。

この場合は、セルA1しか関係していないので、問題ないのですが、以下の場合はどうでしょうか。
こちらは背景色が赤色のセルを数えます。

残念ながら背景色などの変更はセルの値の変更ではないので、数式は更新されません。
ただ、この関数のままですと、対象の範囲内に文字を入力するなどと操作しない限り更新されません。
F9キーで再計算をしても更新されません。

その対策として「揮発性にする」という方法があります。
揮発性という言い方をすると少しややこしいですが、揮発性関数の例を挙げると、TODAY関数などがあります。
この関数は、引数を持たないのですが、どこかのセルが変更されると自動で更新されます。
もちろん、F9キーで再計算しても更新されます。

では、先ほどの関数を揮発性にしていきます。
揮発性にするには、この１行を追加するだけです。

Application.Volatile

これだけで、どこかのセルが変更されるとこの関数が自動で再計算されます。
またF9キーでも再計算されるようになります。

このコード１行を追加するだけで、色を設定した後に「何かしらの作業」をすれば自動で更新されます。
Excelファイルを開いたときにも再計算されるので、集計ミスが削減できるかと思います。

▼サンプルファイル▼

指定した列の値に対して、値が変わる間にデータ行を挿入する方法について解説していきます。
こちらではVBAを使う方法で解説してますが、場合によっては、手動や最終行に追加して並べ替えなどの方が都合が良いこともあるかと思います。

では、次の①の表を②の表にするVBAを確認します。
※B列（カテゴリー）を基準にしています。

こちらを実現するVBAは以下になります。

Sub Sample()
    
    Dim rowNo As Long
    '繰り返しの開始位置
    rowNo = 3
    
    'rowNo行目のB列の値が空になるまで繰り返す
    Do While Cells(rowNo, "B").Value <> ""
    
        'rowNo行目の値とその一つ前の値が異なる場合
        If Cells(rowNo, "B").Value <> Cells(rowNo - 1, "B").Value Then
            '行を挿入
            Rows(rowNo).Insert
            '挿入した分の行数を加える
            rowNo = rowNo + 1
        End If
        '次の行を確認する
        rowNo = rowNo + 1
        
    Loop
    
End Sub

繰り返しの開始位置はデータの2つ目の要素である3行目を指定しています。
1つ目の要素に関して、その行にデータ行を挿入する可能性はないので、2つ目の要素から指定しています。

後は、条件を満たしている間、繰り返し続けるWhile文で開発しています。
※While文内の「rowNo = rowNo + 1」の記述が漏れると、Do Whileの条件「Cells(rowNo, “B”).Value <> “”」を永遠に満たすことになり無限ループになります。
　万が一、無限ループになってしまった場合は、Escキーで強制終了、間に合わなければ、Excel自体を強制終了する必要があります。

【補足】挿入後にカテゴリーの文字を入力したい場合は、次の★のコードを加えます。

Sub Sample()
    
    Dim rowNo As Long
    '繰り返しの開始位置
    rowNo = 3
    
    'rowNo行目のB列の値が空になるまで繰り返す
    Do While Cells(rowNo, "B").Value <> ""
    
        'rowNo行目の値とその一つ前の値が異なる場合
        If Cells(rowNo, "B").Value <> Cells(rowNo - 1, "B").Value Then
            '行を挿入
            Rows(rowNo).Insert
            
            '★カテゴリーを入力する
            Cells(rowNo, "B").Value = Cells(rowNo - 1, "B").Value
            
            '挿入した文の行数を加える
            rowNo = rowNo + 1
        End If
        '次の行を確認する
        rowNo = rowNo + 1
        
    Loop
    
    '★最終行のカテゴリーを入力する
    Cells(rowNo, "B").Value = Cells(rowNo - 1, "B").Value
    
End Sub

最終行のコード（２つ目の★）に関しては、While文を抜けてしまうので、単体でカテゴリーを入力する必要があります。
こちらを実行すると以下のように反映されます。

▼サンプルファイル▼