[[20130117090527]] 『点間の補間2』  ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『点間の補間2』
excel2003利用しています。

 昨日質問してマクロを利用し解決しましたが、できれば関数を使ってできないかと思い
 内容をできるだけ簡易にして再度質問させていただきます。

 以下の4点が定義されています。
 	A列	B列
 1行	1	1
 2行	3	5
 3行	7	3
 4行	11	1

 ・A5に1といれると、A列の1〜4行を参照し、 A1が1なので、B1の値を返す、
 ・A6に2といれると、A列の1〜4行を参照し、A1とA2の中間値なので、B1とB2の中間値を返す
(1,1)と(3,5)を線形補間し(2,3)が
 ・A7に8をいれると、A列の1〜4行を参照し、 A3とA4の1/4の値なので、B3とB4の1/4の値を返す
(7,3)と(11,1)を線形補間し(8,2.5)が

 5行	1	1
 6行	2	3
 7行	8	2.5
 と、A列に任意の数字をいれれば、A1:B4を参照し、B列が算出されるような関数は何かございませんでしょうか?
 4行くらいだといいのですが、100行にもなると、各行で方程式を作成して解くのも非常に面倒になってしまい質問しました。

 よろしくお願いします。
(onono77)


 ※回答削除

 (GobGob)

 ちょっとマズいね。見直ししますわー。

 (GobGob)

 エラーは考慮していません
 =LOOKUP(A5,$A$1:$A$4,$B$1:$B$4)+(A5-LOOKUP(A5,$A$1:$A$4))*(LOOKUP(A5,$A$1:$A$4,$B$2:$B$4)-LOOKUP(A5,$A$1:$A$4,$B$1:$B$4))/(LOOKUP(A5,$A$1:$A$4,$A$2:$A$4)-LOOKUP(A5,$A$1:$A$4))

 By

 マクロを忌諱している理由は処理が遅いからでしょうか。

 やりようによっては、関数よりもマクロのほうが高速に処理できることのほうが
 多いように思います。

 一応ご参考までに。

 Sub main()
                  '// 計測データ  出力位置(左上セル)
    LinearForcast Range("A1:B4"), Range("D1")
 End Sub

 Sub LinearForcast(tblRange As Range, ret As Range)
    Dim tbl
    tbl = tblRange
    With Application.WorksheetFunction
        Dim minT As Long
        minT = .RoundUp(.Min(tbl), 0)

        Dim maxT As Long
        maxT = .RoundDown(.Max(tbl), 0)

        Dim size As Long
        size = maxT - minT + 1
    End With

    Dim res()
    ReDim res(1 To size, 1 To 2)

    Dim tblRefLower As Long
    Dim tblRefUpper As Long
    tblRefLower = 1
    tblRefUpper = 2

    Dim resRow As Long
    Dim xs As Double, xe As Double, ys As Double, ye As Double
    For r = minT To maxT
        Do While tbl(tblRefUpper, 1) < r
            tblRefLower = tblRefLower + 1
            tblRefUpper = tblRefUpper + 1
        Loop
        xs = tbl(tblRefLower, 1)
        xe = tbl(tblRefUpper, 1)

        ys = tbl(tblRefLower, 2)
        ye = tbl(tblRefUpper, 2)

        resRow = resRow + 1
        res(resRow, 1) = r
        If xe <> xs Then
            res(resRow, 2) = ys + (r - xs) * (ye - ys) / (xe - xs)
        Else
            res(resRow, 2) = ys
        End If
    Next
    ret.Resize(UBound(res, 1), UBound(res, 2)) = res
 End Sub

 (Mook)

GobGobさん、Byさん、MOOKさん

Byさんご提案の関数でいまのところエラーもなくできております。
ありがとうございました。
ちなみに、マクロですが、私のデスクトップPCだと非常に時間がかかっていたのですが、
最近のノートで試すと、あっという間に終わりました。
スペックの問題でした。

皆様、いろいろとありがとうございました。

(onono77)


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.