|
初心者 さん、こんばんわ。
>シート内のデータに、項目・数値を用意し、
>リストボックスAのリスト(項目)を選択した際、
>テキストボックスへリストボックスAの数値が表示され、
>コマンドボタンを押すことで、
>リストボックスBへリストボックスAの項目がコピーされ、
>リストボックスBのリスト(項目)を選択した際、
>リストボックスAと同じ数値がテキストボックスへ表示されるようにしたいのですが、
>あれから、しばらく悩んだのですが、
>結局できませんでした。
フォームのコントロール類は、前回と同じ条件です。
Option Explicit
Private Sub CommandButton1_Click()
Dim Li1 As Integer, Lc2 As Integer
'ListBox2に転送時にお互いのListIndex値を覚えておく
With ListBox1
Li1 = .ListIndex
If .List(Li1, 2) < 0 Then
ListBox2.AddItem .List(Li1, 1) '2列目(C列)のデータを追加
Lc2 = ListBox2.ListCount '追加された行
ListBox2.List(Lc2 - 1, 1) = Li1
.List(Li1, 2) = Lc2
End If
End With
End Sub
'
Private Sub ListBox1_Change()
With ListBox1
If .ListIndex >= 0 Then TextBox1.Text = .Text
End With
End Sub
'
Private Sub ListBox2_Change()
Dim Li2 As Integer
With ListBox2
Li2 = Val(.List(.ListIndex, 1))
End With
'エラー回避のため分岐
If Li2 >= 0 Then ListBox1.ListIndex = Li2
'TextBox1.Text = ListBox2.Text
End Sub
Private Sub UserForm_Activate()
Dim Ldat(3 To 10, 1 To 3), RR As Integer, CC As Integer
TextBox1.Text = ""
With ListBox1
.Clear '念のためクリア
.ColumnCount = 3 '隠れ2列あり
.ColumnWidths = .Width & ";0;0"
.TextColumn = 2
End With
With ListBox2
.Clear '念のためクリア
.ColumnCount = 2
.ColumnWidths = .Width & ";0" '隠れ1列あり
End With
'リストを読み込む Worksheets("Sheet1").Range("B3:C10")
For RR = 3 To 10
For CC = 1 To 3
If CC = 3 Then
Ldat(RR, CC) = -1 'リストインデックス取得用(作業列)
Else
Ldat(RR, CC) = Worksheets("Sheet1").Cells(RR, CC + 1)
End If
Next
Next
'セット
ListBox1.List = Ldat()
Erase Ldat
End Sub
こんな感じです。
|
|