| |
▼ちくたく さん：
こんばんは。
>それでも、やっぱりちょっと難しめのコードになっちゃいますね。
掲示板の過去ログを見て、ちくたく さんが綺麗なコードを書かれているので、
当方なりに精一杯恰好つけたつもりです(笑)
選択範囲内をループさせるのではなく、
別の方向から攻めてみました。
Option Explicit
Sub シート処理()
Dim i As Long
Dim j As Long
Dim MyRange As Range
Dim Sabun As Double
With Selection
'列ごとに処理
For i = 1 To .Columns.Count
'基点のセルから Shift ＋ Ctrl ＋ ↓ のセルをつかむ
Set MyRange = Range(.Cells(i), .Cells(i).End(xlDown))
'つかんだセルと選択範囲の最終行を比較
Do Until MyRange(MyRange.Count).Row > .Cells(.Count).Row
'つかんだセルの最初と最後の差分を個数で割る
Sabun = (MyRange(MyRange.Count).Value - MyRange(1).Value) / _
(MyRange.Count - 1)
'空白セルに値を代入
For j = 2 To MyRange.Count - 1
MyRange(j).Value = MyRange(1).Value + Sabun * (j - 1)
Next
'つかんだセルの最後から Shift ＋ Ctrl ＋ ↓ のセルをつかむ
Set MyRange = Range(MyRange(MyRange.Count), _
MyRange(MyRange.Count).End(xlDown))
Loop
Next
End With
Set MyRange = Nothing
End Sub
目安箱にあった Jaka さんのスレッドを参考にさせて頂きました。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=78;id=FAQ
|
|
小僧
- 06/1/31(火) 0:23 -
