| |
▼ぺろ さん：
よこから失礼します
>listbox１からlistbox２へドラッグして値を代入する作業を
>moug(モーグ）のサイトとこちらを参考にして作成しています。
>
>それで、listbox1からlistbox2に移動する際に、
>既にlistbox2に移動させようとしているものが存在している場合、
>移動させないようにしたいのです。
それぞれのリストを Dictionaryオブジェクトに覚えさせておく方法
（毎回 重複してないか調べない方法）です。
'★Microsoft Scripting Runtime への参照設定
Private dic1 As Scripting.Dictionary
Private dic2 As Scripting.Dictionary
Private movRow As Long '移動行
Private movKey As String '移動キー項目
Private Sub UserForm_Initialize()
Dim r As Excel.Range
Dim i As Long
Set dic1 = New Dictionary
Set dic2 = New Dictionary
Set r = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 2)
Set r = Intersect(r, r.Offset(1))
With ListBox1
.List = r.Value
.ColumnCount = 2
.ColumnWidths = "80;229"
For i = 0 To .ListCount - 1
'Dictionaryの KeyにListの1列目を 全列をアイテムに記録
dic1(.List(i, 0)) = WorksheetFunction.Index(r.Rows(i + 1), 0#)
Next
End With
With ListBox2
.ColumnCount = 2
.ColumnWidths = "80;229"
End With
End Sub
'リストボックス１のマウス移動時（ドラッグ開始）
Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'マウス左ボタンのドラッグ時に対応
If Button <> 1 Then Exit Sub
'データオブジェクトに現在の選択値を格納
Dim i As Long
With ListBox1
movRow = .ListIndex
movKey = .List(movRow, 0)
End With
With New DataObject
.StartDrag
End With
End Sub
'二番目のリストボックスにマウスが入った時のイベント
Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, _
ByVal X As Single, ByVal Y As Single, ByVal DragState _
As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
'Cancel=TrueでDrag&Drop継続
Cancel = True
End Sub
'リストボックス2へのドロップ
Private Sub ListBox2_BeforeDropOrPaste(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, _
ByVal Data As MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
Dim ss
Dim i As Long, j As Long '◆
'ドラッグ時のみドラッグされたデータをリスト項目に追加
If Action = fmActionDragDrop Then
If dic2.Exists(movKey) Then Exit Sub
ss = dic1(movKey)
dic2(movKey) = ss
With ListBox2
.AddItem ss(1, 1)
.List(.ListCount - 1, 1) = ss(1, 2)
End With
'-------------------------- 以下はコピーのときは不要
'ListBox1と dic1 から削除
'ListBox1.RemoveItem movRow
'dic1.Remove movKey
End If
End Sub
|
|
kanabun
- 13/7/6(土) 10:16 -
