[[20091108210035]] 『空白のセルを補間する』(1) ページの最後に飛ぶ

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

 

『空白のセルを補間する』(1)

Excel2003、Windows XPを使っています。

例えば、データが以下のように一定の間隔で飛び飛びに入力されているとします。

  .|A |B |C |D .|E |F .|G .|H | I |

1 |10|  |  |  | 9.|  |  |  |13|

2 |  |  |  |  |  |  |  |  |  |

3 |  |  |  |  |  |  |  |  |  |

4 |  |  |  |  |  |  |  |  |  |

5 |20|  |  |  | 5.|  |  |  |11|

6 |  |  |  |  |  |  |  |  |  |

7 |  |  |  |  |  |  |  |  |  |

8 |  |  |  |  |  |  |  |  |  |

9 | 4.|  |  |  | 8.|  |  |  | 2.|

このデータから線形補間で空白のセルを埋めて、
A1:I9の範囲で、全てのセルに数値が表示されるようにしたいのですが、
どのようにすればよいでしょうか?手順としては

1.行の補間をしてから列の補間 
2.列の補間をしてから行の補間

の二通り考えられると思いますが、どちらの方法でも構いません。
この例くらいの範囲だったら手入力で数式を打ち込んでいけばなんとかなるのですが、
実際のデータはもっと大量にあって困っています。
効率の良い方法をご存知の方がおられましたらよろしくお願いします。


 1,2どちらでも、いいですが、Trend関数を使用してはどうでしょうか? (1or8)

 こんにちは。
数式は挫折したので、マクロで作ってみました。
(コタ)

 【マクロ実行前】
  ※「_」セルは未入力または""
  R/C   A   B   C   D   E   F   G   H   I
   1   10   _   _   _   9   _   _   _  13
   2    _   _   _   _   _   _   _   _   _
   3    _   _   _   _   _   _   _   _   _
   4    _   _   _   _   _   _   _   _   _
   5   20   _   _   _   5   _   _   _  11
   6    _   _   _   _   _   _   _   _   _
   7    _   _   _   _   _   _   _   _   _
   8    _   _   _   _   _   _   _   _   _
   9    4   _   _   _   8   _   _   _   2

 【マクロ実行後】
  R/C     A        B       C       D     E      F      G       H     I
   1     10     9.75     9.5    9.25     9     10     11      12    13
   2   12.5   11.375   10.25   9.125     8  9.125  10.25  11.375  12.5
   3     15       13      11       9     7   8.25    9.5   10.75    12
   4   17.5   14.625   11.75   8.875     6  7.375   8.75  10.125  11.5
   5     20    16.25    12.5    8.75     5    6.5      8     9.5    11
   6     16  13.4375  10.875  8.3125  5.75    6.5   7.25       8  8.75
   7     12   10.625    9.25   7.875   6.5    6.5    6.5     6.5   6.5
   8      8   7.8125   7.625  7.4375  7.25    6.5   5.75       5  4.25
   9      4        5       6       7     8    6.5      5     3.5     2

 【Module1】標準モジュール
Option Explicit
Sub test1()
    Dim i As Long, j As Long, v
    '配列にセット
    With ActiveSheet
        i = .Cells(Rows.Count, 1).End(xlUp).Row
        j = .Cells(1, Columns.Count).End(xlToLeft).Column
        v = .Range("A1", .Cells(i, j)).Value
    End With
    '横補間
    Call hokan(v)
    '縦補間
    v = Application.WorksheetFunction.Transpose(v)
    Call hokan(v)
    v = Application.WorksheetFunction.Transpose(v)
    '結果出力
    With ActiveSheet
        .Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
    End With
End Sub

 Private Sub hokan(ByRef v As Variant)
    Dim i As Long, j As Long, k As Long, l As Long
    Dim r1 As Long, c1 As Long, r2 As Long, c2 As Long

    For i = 1 To UBound(v, 1) '行
        If v(i, 1) <> "" Then
            For j = 1 To UBound(v, 2) '列
                If v(i, j) <> "" Then
                    r1 = r2: c1 = c2
                    r2 = i: c2 = j
                    l = l + 1
                    If l > 1 Then
                        For k = 1 To c2 - c1 - 1 '横補間
                            v(r1, c1 + k) = ((c2 - c1 - k) * v(r1, c1) + k * v(r2, c2)) / (c2 - c1)
                        Next
                    End If
                End If
            Next
            l = 0
        End If
    Next
End Sub

コメント返信:

[ 一覧(最新更新順) ]


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