|
シートモジュールに書いてください。
テストを十分していないので、そちらで検証してください。
Sub test()
Dim ws As Worksheet
Dim rng As Range
Dim j As Long
Dim jj As Long
Dim k As Long
Dim ruiseki As Long
Dim p As Long
Dim ary As Variant
Set rng = Worksheets("シートA").Range("投入範囲")
Set ws = Worksheets("アンケート項目")
'オプションの数
ary = Array(10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20)
For k = 1 To 17
For j = 1 To ary(k - 1)
jj = ruiseki + j
If Me.OLEObjects("OptionButton" & jj).Object.Value = True Then
rng.Cells(a, k + 1).Value = ws.Cells(j + 2, k + 1)
' Exit For
End If
Next
ruiseki = ruiseki + ary(k - 1)
Next
End Sub
|
|