Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7813 / 76734 ←次へ | 前へ→

【74504】リストボックスからリストボックスへ重複なしで移動させたいです。
質問  ぺろ  - 13/7/5(金) 16:30 -

引用なし
パスワード
   こんにちは
お助けください。

listboxを2つ作成し、
listbox1からlistbox2へドラッグして値を代入する作業を
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


'リストボックス1のマウス移動時(ドラッグ開始)
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

'リストボックス2へのドラッグ(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

3 hits

【74504】リストボックスからリストボックスへ重複なしで移動させたいです。 ぺろ 13/7/5(金) 16:30 質問
【74507】Re:リストボックスからリストボックスへ重... UO3 13/7/6(土) 3:29 発言
【74508】Re:リストボックスからリストボックスへ重... kanabun 13/7/6(土) 10:16 発言
【74509】Re:リストボックスからリストボックスへ重... ぺろ 13/7/6(土) 11:02 発言
【74510】Re:リストボックスからリストボックスへ重... kanabun 13/7/6(土) 11:07 発言
【74511】Re:リストボックスからリストボックスへ重... ぺろ 13/7/6(土) 11:19 お礼
【74512】Re:リストボックスからリストボックスへ重... ichinose 13/7/7(日) 20:14 発言
【74513】Re:リストボックスからリストボックスへ重... ぺろ 13/7/8(月) 8:25 お礼

7813 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free