清除 ListBox 及 ComboBox 中重复的项目 当我们要将一大堆资料加入 ListBox 或 ComboBox 时,为了不让 ListBox 或 ComboBox 中的项目重复,有些人会在将新项目加入 ListBox 或 ComboBox 时,就先作项目比对,资料没有重复时,才将资料加入 ListBox 或 ComboBox 中。 但是如果我们将资料统统加入 ListBox 或 ComboBox 之后,再来执行比对动作,不但程序容易维护,而且速度会加快一点点,以下的模组就是做项目比对,以清除 ListBox 或 ComboBox 中重复的项目。 模组中需要传入二个参数,说明如下: 1、控制项名称:可传入 ListBox 或 ComboBox 的名称。 2、是否分别大小写:True 表示要分别大小写,False 则不分大小写。 Sub RemoveDups(lst As Control, comptype As Boolean) Dim lPos As Long '原始比对项目 index Dim lCompPos As Long '待比对项目 index Dim sComp As String '原始比对字串 Dim sComptype As Long '0(binary) / 1(textual) 比对lPos = 0 If comptype Then sComptype = 0 Else sComptype = 1 Do While lPos < (lst.ListCount - 1) sComp = lst.List(lPos) lCompPos = lPos + 1 Do While lCompPos < lst.ListCount If StrComp(sComp, lst.List(lCompPos), sComptype) = 0 Then lst.RemoveItem lCompPos lCompPos = lCompPos - 1 End If lCompPos = lCompPos + 1 Loop lPos = lPos + 1 Loop End Sub '在程序中使用方式如下: '要分别大小写 Private Sub Command1_Click() RemoveDups List1, True RemoveDups Combo1, True End Sub '不分别大小写 Private Sub Command2_Click() RemoveDups List1, False RemoveDups Combo1, False End Sub
当我们要将一大堆资料加入 ListBox 或 ComboBox 时,为了不让 ListBox 或 ComboBox 中的项目重复,有些人会在将新项目加入 ListBox 或 ComboBox 时,就先作项目比对,资料没有重复时,才将资料加入 ListBox 或 ComboBox 中。
但是如果我们将资料统统加入 ListBox 或 ComboBox 之后,再来执行比对动作,不但程序容易维护,而且速度会加快一点点,以下的模组就是做项目比对,以清除 ListBox 或 ComboBox 中重复的项目。
模组中需要传入二个参数,说明如下:
1、控制项名称:可传入 ListBox 或 ComboBox 的名称。
2、是否分别大小写:True 表示要分别大小写,False 则不分大小写。
Sub RemoveDups(lst As Control, comptype As Boolean)
Dim lPos As Long '原始比对项目 index
Dim lCompPos As Long '待比对项目 index
Dim sComp As String '原始比对字串
Dim sComptype As Long '0(binary) / 1(textual) 比对lPos = 0
If comptype Then sComptype = 0 Else sComptype = 1
Do While lPos < (lst.ListCount - 1)
sComp = lst.List(lPos)
lCompPos = lPos + 1
Do While lCompPos < lst.ListCount
If StrComp(sComp, lst.List(lCompPos), sComptype) = 0 Then
lst.RemoveItem lCompPos
lCompPos = lCompPos - 1
End If
lCompPos = lCompPos + 1
Loop
lPos = lPos + 1
Loop
End Sub
'在程序中使用方式如下:
'要分别大小写
Private Sub Command1_Click()
RemoveDups List1, True
RemoveDups Combo1, True
End Sub
'不分别大小写
Private Sub Command2_Click()
RemoveDups List1, False
RemoveDups Combo1, False
End Sub