CODEPOOL

趣味でやるプログラミング関連のMEMO置き場。

2次元テーブルデータの内挿補間関数を書いてみた

Excel VBA

どうも、キヨタです。

今まで謎に未経験でしたが、血迷ってExcel VBAデビューしてみました。

2次元テーブルデータから中間の値を内挿補間して求める作業を山ほどやらなければならなくなったのですが、MATCHとかVLOOKUPとかで管理するのがもう面倒になったので関数化してみた次第です。

結果的には大変快適でした。

要求仕様

f:id:yujikiyota:20200603004817p:plain
Fig.1 Excel上でのTableデータ配置イメージ

想定しているデータはFig.1に示したような2次元の数値データで、x_rangeを定義域とするx_valとy_rangeを定義域とするy_valで示されたIndexに相当するデータをdata_range内のデータから内挿補間して生成する関数を作ります。

作っている途中でx_val y_valが定義域から外れるとよくわからない謎の数値を返す事が分かったので、定義域外の入力に対しては#N/Aを返すことにしました。

f:id:yujikiyota:20200603004054p:plain
Fig.2 2次元テーブルデータの内挿補間

内挿補間の方法は至ってシンプルで、VBAからMatch関数で引き当てたd11 d12 d21 d22を用いて下記の計算をしています。

\begin{aligned} d_{m1} &= d_{11} + (d_{21}-d_{11})\times\frac{x_{val}-x_1}{x_2-x_1} \\ d_{m2} &= d_{12} + (d_{22}-d_{12})\times\frac{x_{val}-x_1}{x_2-x_1} \\ d_{mm} &= d_{m1} + (d_{m2}-d_{m1})\times\frac{y_{val}-y_1}{y_2-y_1} \end{aligned}

ソースコード

Function InterLin2D(x_val As Double, x_range As Range, y_val As Double, y_range As Range, data_range As Range)

    Dim x_index, y_index As Long
    Dim x1, x2, y1, y2, x_min, x_max, y_min, y_max, d11, d12, d21, d22, dm1, dm2, dmm As Double
    
    ' Get min/max value of x/y axis
    x_min = WorksheetFunction.Min(x_range)
    x_max = WorksheetFunction.Max(x_range)
    y_min = WorksheetFunction.Min(y_range)
    y_max = WorksheetFunction.Max(y_range)
    
    ' Get smaller value index
    x_index = WorksheetFunction.Match(x_val, x_range, 1)
    y_index = WorksheetFunction.Match(y_val, y_range, 1)
    
    ' Get reference axis value
    x1 = x_range(x_index)
    x2 = x_range(x_index + 1)
    y1 = y_range(y_index)
    y2 = y_range(y_index + 1)
    
    ' Get reference data value
    d11 = data_range(y_index, x_index)
    d12 = data_range(y_index + 1, x_index)
    d21 = data_range(y_index, x_index + 1)
    d22 = data_range(y_index + 1, x_index + 1)
    
    ' Calc interpolated data value for x-direction
    dm1 = d11 + (d21 - d11) * (x_val - x1) / (x2 - x1)
    dm2 = d12 + (d22 - d12) * (x_val - x1) / (x2 - x1)

    ' Calc 2D interpolated data value
    dmm = dm1 + (dm2 - dm1) * (y_val - y1) / (y2 - y1)
    
    ' If x_val/y_val is out of function domain, return #N/A
    If x_min <= x_val And x_val < x_max And y_min <= y_val And y_val < y_max Then
        InterLin2D = dmm
    Else
        InterLin2D = CVErr(xlErrNA)
    End If
    
End Function

所感

  • 血迷ってExcel VBAデビューしてみたらMATCHとかINDEXとかのセル直書きから開放されて結構快適だった
  • なんかreturn文とかが無さそうだったので引数の定義域外判定がソースコード後半にきてしまって気持ち悪かったので良い方法がないか調べたい
  • ExcelのコードエディタをVS Codeみたくもう少し格好よくしても良いと思いますMicrosoftさん
  • どうやらC#とかでも書けるらしいので一度試してみたい。