| |
いつもお世話になっております。
標題につきまして、質問させて頂きます。
下のように、数値が飛び飛びに入った表があります。
数値が入っていないところは空欄になっています。
この空欄に、数値を補完するという処理を考えています。
で、コードを書いてみたのですが、深みにはまったようで、
えらく複雑になってしまいました。
もっと、単純な書き方はないかなぁ、と思い、質問させて頂きます。
まず、最初の表は、例えば以下のような感じ。
A B C
1 1 3
2 4
3
4 7
5 5
処理結果は、以下のようになります。
小数点に関しては、丸めてます。
A B C
1 1 3
2 2 4.33 4
3 3 5.66 5.25
4 4 6.99 6.5
5 5 7.99 7.75
コードは以下のようになります。
もっと、単純に書ける気がするのですが、思いつきません。
お知恵をお貸し頂ければ幸いです。
Sub 数値の補完()
Dim myArr As Variant, cNum As Integer
Dim myR As Range, i As Integer
Dim myF As Integer, cMin As Double, cMax As Double
Dim tmpNum As Double, tmpR(1) As Integer
Dim j As Integer, sRow As Integer
cNum = 0: myF = 0: cMin = 0: cMax = 0 '//変数の初期化。
For Each myC In Selection.Columns '//列ごとに処理
myArr = myC
cNum = myC.Column: sRow = Selection.Row '//行と列を取得しておく。
For i = 1 To UBound(myArr, 1)
If myArr(i, 1) <> "" Then '//列のある値が0でなかった場合に、格納。
If myF = 0 Then
cMin = myArr(i, 1)
tmpR(0) = i
myF = 1
End If
If myF = 1 Then '//で、フラグを使って処理。
cMax = myArr(i, 1)
tmpR(1) = i
End If
If cMin <> cMax And tmpR(1) - tmpR(0) <> 1 Then '//実質の処理
tmpNum = (cMax - cMin) / (tmpR(1) - tmpR(0))
tmpNum = Round(tmpNum, 2) '//丸めの処理。今は小数点2位
For j = tmpR(0) To tmpR(1) - 1
Cells(sRow + j, cNum).Value = Cells(sRow + j, cNum).Offset(-1, 0).Value + tmpNum
Next j
myF = 1: cMin = cMax: cMax = 0: tmpR(0) = tmpR(1)
End If
End If
Next i
myF = 0: cMin = 0: cMax = 0
Next myC
End Sub
|
|
ちくたく
- 06/1/30(月) 10:49 -
