vb6 如何彻底删除list中重复项?

Question

比如
---
1
2
3
2
---
删除后的效果是
---
1
3
---
也就是说list中的项一旦出现重复,那就彻底删除,一个不留!
'//说明一下,也就是说我要的效果不是:
---
1
2
3
---
这个2不能留下!!!(如果留下,下面这个代码就可以实现)
-----
Private Sub Command1_Click()
dim i,j as integer
    With List1
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To i + 1 Step -1
                If .List(j) = .List(i) Then
                    .RemoveItem j                    
                End If
            Next j
        Next i
    End With
end sub
-------------
我试了一下多加一行".RemoveItem i",已证明不行,会出错:   
-----
Private Sub Command1_Click()
dim i,j as integer
    With List1
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To i + 1 Step -1
                If .List(j) = .List(i) Then
                    .RemoveItem j   
                    .RemoveItem i                    
                End If
            Next j
        Next i
    End With
end sub
-------------thanks!

Answer 1

Private Const LB_FINDSTRING = &H18F
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Sub Command1_Click()
Dim i As Integer
Dim iIndex As Long
If List1.ListCount = 0 Then Exit SubFor i = List1.ListCount - 1 To 1 Step -1
    iIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal List1.List(i))
    If (iIndex < i) And (iIndex <> -1) Then
        List1.RemoveItem i
    End If
Next
End SubPrivate Sub Form_Load()
List1.AddItem "1"
List1.AddItem "2"
List1.AddItem "3"
List1.AddItem "2"
List1.AddItem "a"
List1.AddItem "2"
List1.AddItem "c"
List1.AddItem "2"
List1.AddItem "b"
List1.AddItem "c"
List1.AddItem "d"
List1.AddItem "w"
List1.AddItem "a"
List1.AddItem "fgh"
End Sub

Answer 2

谢谢hpygzhx520，试下先，谢谢！

Answer 3

笨一点的方法,很简单:用一个数组将重复的字符保存下来,然后循环数组,删除list中的项.

Answer 4

这个不是我要的效果，我要的是彻底完全删除！也就是说list中的项一旦出现重复,那就彻底删除,一个不留!
兄台这个和我上面那个代码的效果是一样的，2 a c都会留下！我要的是2 a c这种一旦出现两次以上，那就连根拔除！！一个不留！！
比如
---
1
2
3
2
---
删除后的效果要是
---
1
3
---
而不是
1
2
3
--
！！！！！！！！！
谢谢！！

Answer 5

Private Sub Command1_Click()
    Dim i As Integer, j As Integer
    Dim blnD() As Boolean
    
    ReDim blnD(List1.ListCount - 1)
    
    With List1
        For i = 0 To .ListCount - 1
            For j = i + 1 To .ListCount - 1
                If .List(j) = .List(i) Then
                    blnD(j) = True
                    blnD(i) = True
                End If
            Next j
        Next i
            
        For i = .ListCount - 1 To 0 Step -1
            If blnD(i) Then
                .RemoveItem i
            End If
        Next i
    End With
End SubPrivate Sub Form_Load()
    List1.AddItem "1"
    List1.AddItem "2"
    List1.AddItem "3"
    List1.AddItem "2"
    List1.AddItem "4"
    List1.AddItem "3"
    List1.AddItem "5"
    List1.AddItem "2"
End Sub

Answer 6

代码有点冗余，自己简化。
Private a, b, c As Variant
Private Sub Command1_Click()
Dim i, j As Integer
    With List1
        For i = 0 To .ListCount - 1
            For j = .ListCount - 1 To i + 1 Step -1
                If .List(j) = .List(i) Then
                    a = i & "," & a
                    .RemoveItem j
                End If
            Next j
        Next i
        Debug.Print a
        a = Split(a, ",")
        For i = 1 To UBound(a)
            For j = i + 1 To UBound(a)
                If a(i) = a(j) Then
                    a(j) = ""
                End If
            Next j
        Next i
        c = Replace(Join(a, ""), "", ""): ReDim b(Len(c) - 1)
        For i = 1 To Len(c)
            .RemoveItem CInt(Mid(c, i, 1))
        Next
   
    End With
End SubPrivate Sub Form_Load()
    List1.AddItem "1"
    List1.AddItem "2"
    List1.AddItem "3"
    List1.AddItem "2"
    List1.AddItem "a"
    List1.AddItem "2"
    List1.AddItem "c"
    List1.AddItem "2"
    List1.AddItem "b"
    List1.AddItem "c"
    List1.AddItem "d"
    List1.AddItem "w"
    List1.AddItem "a"
    List1.AddItem "fgh"
End Sub

Answer 7

我用另种方法 请先将 List1的属性 MultiSelect 设为True
Dim i&, j&, aa$, S
Private Sub Form_Load()
   For i = 1 To 20
      List1.AddItem CStr(i)
      aa = aa & CStr(i) & " "
   Next i
   For i = 1 To 20 Step 2
      List1.AddItem CStr(i)
      aa = aa & CStr(i) & " "
   Next i
   S = Split(Trim(aa), " ")
End SubPrivate Sub Command1_Click()
   For i = 0 To UBound(S)
      ChkID = i
      Call ChkDuplicate(S(i))
   Next i
End SubFunction ChkDuplicate(Tstr) As Boolean
   Dim CountD&
   For j = 0 To List1.ListCount - 1
      If List1.List(j) = Tstr Then
         List1.Selected(j) = True: CountD = CountD + 1
      End If
   Next j
   If CountD > 1 Then
      For j = List1.ListCount - 1 To 0 Step -1
         If List1.Selected(j) Then List1.RemoveItem j '如果此笔被选中则删除
      Next j
   End If
   For j = 0 To List1.ListCount - 1
      List1.Selected(j) = False
   Next j
End Function

Answer 8

呵 贴错了 重发
Dim i&, j&, aa$, S
Private Sub Form_Load()
   For i = 1 To 20
      List1.AddItem CStr(i)
      aa = aa & CStr(i) & " "
   Next i
   For i = 1 To 20 Step 2
      List1.AddItem CStr(i)
      aa = aa & CStr(i) & " "
   Next i
   S = Split(Trim(aa), " ")
End SubPrivate Sub Command1_Click()
   For i = 0 To UBound(S)
      Call ChkDuplicate(S(i))
   Next i
End SubSub ChkDuplicate(Tstr)
   Dim CountD&
   For j = 0 To List1.ListCount - 1
      If List1.List(j) = Tstr Then
         List1.Selected(j) = True: CountD = CountD + 1
      End If
   Next j
   If CountD > 1 Then
      For j = List1.ListCount - 1 To 0 Step -1
         If List1.Selected(j) Then List1.RemoveItem j '如果此笔被选中则删除
      Next j
   End If
   For j = 0 To List1.ListCount - 1
      List1.Selected(j) = False
   Next j
End Sub

Answer 9

结贴。谢谢jhone99和lxq19851204.高手出招，利落干净！景仰中！！
cbm666：不好意思，结贴了才看到你的回复，没法给分了,上次还帮我解决了个题呢，不好意思！!

Answer 10

再简化Dim i&, j&, aa$, S
Private Sub Form_Load()
   S = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 3, 5, 7, 9)
   For i = 0 To UBound(S)
      List1.AddItem S(i)
   Next i
End SubPrivate Sub Command1_Click()
   For i = 0 To UBound(S)
      Call ChkDuplicate(S(i))
   Next i
End SubSub ChkDuplicate(Tstr)
   Dim CountD&
   For j = 0 To List1.ListCount - 1
      If List1.List(j) = Tstr Then
         List1.Selected(j) = True: CountD = CountD + 1
      End If
   Next j
   If CountD > 1 Then
      For j = List1.ListCount - 1 To 0 Step -1
         If List1.Selected(j) Then List1.RemoveItem j '如果此笔被选中则删除
      Next j
   End If
   For j = 0 To List1.ListCount - 1
      List1.Selected(j) = False
   Next j
End Sub