2002年的时候，因为要用到大量的list来选择数据，于是做了一个模块。
经过这么多年的测试，使用绝对稳定快捷。
提供
单Item函数：
cmdDel_Click
cmdAdd_Click
多Item函数：
cmdDelAll_Click
cmdAddAll_Click
---------------------------------------------------------------------------------------------------------------------
'Option Explicit
'author:nyb
'Time:2002-04-05
'传入list1,list2，然后我们可以对list1，和list2中的item进行处理.
'*All areas of code where modifications are necessary
'*to integrate this object with a project are documented
'with comments denoted by Note:.
'*To locate these comments,search for ‘*NOTE::.
'****************************************************************************************
Public Sub cmdDelAll_Click(List1 As ListBox, List2 As ListBox) '<<
'*purpose: delete all list2.item
'*Accept: list1 没有用，list2处理对象
For i = (List2.ListCount - 1) To 0 Step -1
List2.RemoveItem i
Next i
End Sub
Public Sub CmdAdd2To1_Click(List1 As ListBox, List2 As ListBox, List3 As ListBox) '>>
'*purpose: all item of list1 and list2 are inputed to list3
'*Accept: list1,list2
For i = 0 To (List1.ListCount - 1)
List3.AddItem List1.List(i)
Next i
For i = 0 To (List2.ListCount - 1)
List3.AddItem List2.List(i)
Next i
End Sub
Public Sub cmdAddAll_Click(List1 As ListBox, List2 As ListBox, Index As Integer) '>>
'*purpose: add all item of list1 inputed to list2.if item had been there, It won't be inputed
'*Accept: list1,list2
If List2.ListCount = 0 Then
For i = 0 To (List1.ListCount - 1)
List2.AddItem List1.List(i)
Next i
Else
For i = 0 To (List1.ListCount - 1)
Flag = CheckSelected(List1, List2, List1.List(i))
If Flag = "notbe" Then List2.AddItem List1.List(i)
Next i
End If
End Sub
Public Sub cmdDel_Click(List1 As ListBox, List2 As ListBox) '<---
'*purpose: the selected items of list2 are cleared
'*Accept: list1 没有用，list2处理对象
Dim i As Integer
If List2.SelCount > 0 Then
For i = (List2.ListCount - 1) To 0 Step -1
If List2.Selected(i) = True Then List2.RemoveItem i
Next i
End If
End Sub
Public Sub cmdadd_Click(List1 As ListBox, List2 As ListBox, Index As Integer) '--->
'*purpose: the selected items of list1 is inputed into list2
' list2为空，list2又可以多选，那么items selected in list1 are inputed to list2
' list2不为空，list2又可以多选，那么先检查item是否在list2中，如果在，那么就不添入list2
' list2设为单选，那么list2只添加list1中的的第一选中项
'*Accept: list1 选中的项目，list2为要加入的listbox
Dim i As Integer
Dim Flag As String
If Index > 0 Then
If List2.ListCount >= 1 Then
If Index = 2 Then
If List2.ListCount >= 2 Then
If List1.MultiSelect = 0 Then
MsgBox "只能选定两期对比！", vbExclamation, "操作提示！"
Exit Sub
End If
End If
End If
End If
End If
If List2.ListCount = 0 And List2.MultiSelect = 2 Then
For i = 0 To (List1.ListCount - 1)
If List1.Selected(i) = True Then List2.AddItem List1.List(i)
Next i
ElseIf List2.ListCount > 0 And List2.MultiSelect = 2 Then
For i = 0 To (List1.ListCount - 1)
Flag = CheckSelected(List1, List2, List1.List(i))
If List1.Selected(i) = True And Flag = "notbe" Then List2.AddItem List1.List(i)
Next i
ElseIf List2.MultiSelect = 0 Then
Call cmdDelAll_Click(List1, List2)
For i = 0 To (List1.ListCount - 1)
If List1.Selected(i) = True Then List2.AddItem List1.List(i)
Next i
End If
Call ClearSelect(List1)
End Sub
Private Function CheckSelected(List1 As ListBox, List2 As ListBox, CityItem As String) As String
'*purpose: '检查item是否已经被添加,已添加则CheckSelected = "be"
'*Accept: list1 选中的项目，list2为要加入的listbox,CityItem为list1 中一个被选中的项目
'*Feedback: CheckSelected , "be" 表示这个item在list２中存在
For i = (List2.ListCount - 1) To 0 Step -1
If CityItem = List2.List(i) Then
CheckSelected = "be"
Exit For
Else: CheckSelected = "notbe"
End If
Next i
End Function
Private Sub ClearSelect(List1)
'*purpose: Clear List1's selected
'*Accept: list1 ,the list box to clear selected
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
List1.Selected(i) = False
End If
Next i
End Sub
本文地址：http://com.8s8s.com/it/it42477.htm