|
おはようございます。
ワークシート関数を使ってみました。
新規ブックの未入力のアクティブシートで
適当にセル範囲を選択した状態でsampleを実行してみて下さい。
'========================================================
Sub sample()
Dim rng As Range
Set rng = Selection
With rng
.Formula = "=if(mod(int(rand()*" & .Count & ")+1,2),"""",int(rand()*" & .Count & ")+1)"
.Value = .Value
End With
MsgBox "sample complete and start test"
'****************** ↑ サンプル作成
call test
End Sub
'=================================================================
Sub test()
Dim idx As Long
Dim colrng As Range
Dim crng As Range
Dim f_ans
On Error Resume Next
For Each colrng In Selection.Columns
If colrng.Rows.Count > 1 Then
With colrng.SpecialCells(xlCellTypeConstants, xlNumbers)
idx = 1
ReDim v(1 To .Count)
ReDim r(1 To .Count)
For Each crng In .Cells
v(idx) = crng.Value
r(idx) = crng.Row
idx = idx + 1
Next
End With
For Each crng In colrng.SpecialCells(xlCellTypeBlanks)
f_ans = Application.Match(crng.Row, r(), 1)
crng.Value = Round((v(f_ans + 1) - v(f_ans)) / (r(f_ans + 1) - r(f_ans)) * _
(crng.Row - r(f_ans)) + v(f_ans), 2)
Next
End If
Next
Set colrng = Nothing: crng = Nothing
Erase v(), r()
End Sub
|
|