配列からの値貼り付けに関する覚書　② 値と数式の混在は成立しない場合がある（失敗談）

先日体験した失敗談からのご紹介。
f:id:Infoment:20210301225941p:plain

例えば、こんなテーブルでのお話。
f:id:Infoment:20210301230050p:plain

納期は基本的に、発注日の１４日後だ。
f:id:Infoment:20210301230149p:plain

ところが、このテーブルの使用者から、こんな要望が寄せられた。

果物によっては、納期が変わる場合があって、納期のセルを上書きしたい。
上書きの条件は複数様々あり、定まっていない。
手入力用の列は設けたくない。

列の内容が数式と手書きで混在するなどやりたくなかったが、要望だから
仕方がない。とここで、閃いた。例えば、こんな方法はどうだろう？

納期列に値を張り付けるための配列を準備する。
もともと設定されていた数式を取得する。
各行をループし、上書き条件を満たす場合は値を、
それ以外の場合は数式をセットする。
３．を列に貼り付ける。

これは、我ながら中々の名案だと思った。早速試してみよう。今回は試しに、
「みかん」の時だけ納期を発注日の１週間後にしてみた。

Sub Test()
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
    
    ' 値貼り付け先の範囲を設定。
    Dim TargetRange As Range
    Set TargetRange = Tb.ListColumns("納期").DataBodyRange
    
    ' もともと設定されている式を取得。
    Dim FormulaText As String
    Dim r As Range
        For Each r In TargetRange
            If r.HasFormula Then
                FormulaText = r.Formula
                Exit For
            End If
        Next
    
    ' 貼り付け用の配列を取得。貼り付け先の範囲を一旦配列に
    ' 格納することで、配列のサイズ調節を省略。
    Dim TargetArray As Variant
        TargetArray = TargetRange
    
    ' 品名が「みかん」のとき、納期を発注日の１週間後に設定。
    ' それ以外の品名ならば、もともとの数式を残しておく。
    Dim i As Long
        For i = 1 To Tb.ListRows.Count
            If Tb.ListRows(i).Range(Tb.ListColumns("品名").Index) = "みかん" Then
                TargetArray(i, 1) = Tb.ListRows(i).Range(Tb.ListColumns("発注日").Index) + 7
            Else
                TargetArray(i, 1) = FormulaText
            End If
        Next
    
    ' 配列を値貼り付け。
        TargetRange = TargetArray
End Sub