| |
こんにちは
お助けください。
listboxを２つ作成し、
listbox１からlistbox２へドラッグして値を代入する作業を
moug(モーグ）のサイトとこちらを参考にして作成しています。
(以下のマクロです）
それで、listbox1からlistbox2に移動する際に、
既にlistbox2に移動させようとしているものが存在している場合、
移動させないようにしたいのです。
現状では、同じ項目をドラッグした場合、listbox2に同じものが
いくつも並んでしまいます。
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim LastRow As Long
Dim mydata As Variant
With Sheets("ﾏｽﾀ1")
LastRow = .Range("A1").CurrentRegion.Rows.Count
mydata = .Range(.Cells(2, 1), .Cells(LastRow, 2)).Value
End With
With ListBox1
.List = mydata
.ColumnCount = 2
.ColumnWidths = "80;229"
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
ReDim ss(.ColumnCount - 1)
For i = 0 To .ColumnCount - 1
ss(i) = .List(.ListIndex, i)
Next i
End With
With New DataObject
.SetText Join(ss, vbTab)
.StartDrag
End With
End Sub
'リストボックス２へのドラッグ（In)
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, j As Long
Dim NewIndex As Long
'ドラッグ時のみドラッグされたデータをリスト項目に追加
If Action = fmActionDragDrop Then
ss = Split(Data.GetText(), vbTab)
With ListBox2
.AddItem ss(0), NewIndex
For i = 1 To UBound(ss)
.List(NewIndex, i) = ss(i)
Next i
End If
End With
End If
Data.Clear 'DataObjectのデータクリア
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
