excel リストボックスを使った入力について

excelにリストボックスを使って、複数の入力を一括で行いたいと考えています。

添付画像のように、横並びに入力する方法、縦並びに入力する方法があるのですが、
番号順に入力を自動で行う手順を作成している段階で詰まっております。

考えとしては
アクティブのセル（番号1）から、リストボックスを起動し、for nextを使って順に入力
リストボックスで一度入力されたものは、Selectedコマンドにてfalseとし、
次の入力（番号2）に進むようにする。
それぞれ、3、6の入力後、次の行（列）の1の同行（同列）に移動する。


この3、6の位置で行列が切り替わるようにプログラムを組む方法で詰まっております。
なお、入力するセルの個数につきましては、最低1個、最大で9個となり、変化します。

アドバイスいただければと思います。また、別法でも構いません。
よろしくお願いします。

No.1 回答者： keithin 回答日時： 2012/02/02 16:08

基点セルはユーザーフォームが起動した時点でのアクティブセルで良いとして，

＞入力するセルの個数につきましては、最低1個、最大で9個となり、変化します。

これは「幾つ入力する」か不明と言ってるだけで，「３列で折り返す」のは常に固定でいいんですね。



準備：
ユーザーフォームにListBox1があり，９個の元ネタを表示するよう設定済みである
ListBox1は事前にMustiSelectをfmMultiSelectMultiにしておく
＃複数選択可能として，選択されている項目を選択順にシートに転記する


マクロ：
Dim a() As Variant

Private Sub ListBox1_Change()
　Dim i, n
　Dim aTemp As Variant
　If Me.ListBox1.Selected(Me.ListBox1.ListIndex) Then
　　If Sgn(a) = 0 Then
　　　ReDim a(0)
　　Else
　　　ReDim Preserve a(UBound(a) + 1)
　　End If
　　a(UBound(a)) = Me.ListBox1.List(Me.ListBox1.ListIndex)
　Else
　　aTemp = Filter(a, Me.ListBox1.List(Me.ListBox1.ListIndex), False)
　　If UBound(aTemp) = -1 Then
　　　Erase a
　　Else
　　　ReDim a(UBound(aTemp))
　　End If
　　For i = 0 To UBound(aTemp)
　　　ReDim Preserve a(i)
　　　a(i) = aTemp(i)
　　Next i
　End If

　ActiveCell.Range("A1:C3").ClearContents
　If Sgn(a) <> 0 Then
　　For i = 0 To UBound(a)
　　　ActiveCell.Range("A1:C3").Cells(i + 1) = a(i)
　　Next i
　End If
End Sub



＃＃思いつきでちょこちょこっと書いてみたので全然整理できてないのはご容赦。