Excel VBA質問箱 IV

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

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


7809 / 76734 ←次へ | 前へ→

【74508】Re:リストボックスからリストボックスへ重複なしで移動させたいです。
発言  kanabun  - 13/7/6(土) 10:16 -

引用なし
パスワード
   ▼ぺろ さん:

よこから失礼します

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


'リストボックス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
   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

5 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 お礼

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