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

clintonus 2010-11-16 09:34:13
比如
---
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!
...全文
629 13 打赏 收藏 转发到动态 举报
写回复
用AI写文章
13 条回复
切换为时间正序
请发表友善的回复…
发表回复
cbm6666 2010-11-16
  • 打赏
  • 举报
 回复
哈哈哈 有机会请我抽根烟 胜过给我1000分

cbm6666 2010-11-16
  • 打赏
  • 举报
 回复
再简化

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 Sub

Private Sub Command1_Click()
For i = 0 To UBound(S)
Call ChkDuplicate(S(i))
Next i
End Sub

Sub 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
clintonus 2010-11-16
  • 打赏
  • 举报
 回复
结贴。谢谢jhone99和lxq19851204.高手出招，利落干净！景仰中！！
cbm666：不好意思，结贴了才看到你的回复，没法给分了,上次还帮我解决了个题呢，不好意思！!

cbm6666 2010-11-16
  • 打赏
  • 举报
 回复
呵 贴错了 重发


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 Sub

Private Sub Command1_Click()
For i = 0 To UBound(S)
Call ChkDuplicate(S(i))
Next i
End Sub

Sub 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
cbm6666 2010-11-16
  • 打赏
  • 举报
 回复
我用另种方法 请先将 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 Sub

Private Sub Command1_Click()
For i = 0 To UBound(S)
ChkID = i
Call ChkDuplicate(S(i))
Next i
End Sub

Function 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


lxq19851204 2010-11-16
  • 打赏
  • 举报
 回复
[Quote=引用 6 楼 jhone99 的回复:]
VB code
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 -……
[/Quote]
还是JHONG99的代码简单明了...
lxq19851204 2010-11-16
  • 打赏
  • 举报
 回复
代码有点冗余，自己简化。
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 Sub



Private 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
jhone99 2010-11-16
  • 打赏
  • 举报
 回复 
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 Sub



Private 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
clintonus 2010-11-16
  • 打赏
  • 举报
 回复
[Quote=引用 1 楼 hpygzhx520 的回复:]
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 Long

……
[/Quote]
这个不是我要的效果，我要的是彻底完全删除！也就是说list中的项一旦出现重复,那就彻底删除,一个不留!
兄台这个和我上面那个代码的效果是一样的，2 a c都会留下！我要的是2 a c这种一旦出现两次以上，那就连根拔除！！一个不留！！
比如
---
1
2
3
2
---
删除后的效果要是
---
1
3
---
而不是
1
2
3
--
！！！！！！！！！
谢谢！！
lxq19851204 2010-11-16
  • 打赏
  • 举报
 回复
king06 2010-11-16
  • 打赏
  • 举报
 回复
笨一点的方法,很简单:用一个数组将重复的字符保存下来,然后循环数组,删除list中的项.
clintonus 2010-11-16
  • 打赏
  • 举报
 回复
谢谢hpygzhx520，试下先，谢谢！
hpygzhx520 2010-11-16
  • 打赏
  • 举报
 回复
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 Long

Private Sub Command1_Click()
Dim i As Integer
Dim iIndex As Long
If List1.ListCount = 0 Then Exit Sub

For 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 Sub

Private 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
2021-2022计算机二级等级考试试题及答案No.1403.docx
2021-2022计算机二级等级考试试题及答案No.1403.docx
2021-2022计算机二级等级考试试题及答案No.11632.docx
2021-2022计算机二级等级考试试题及答案No.11632.docx
VB6控件详解与实战参考手册（WDL格式）
Visual Basic 6.0（VB6）通过可视化控件实现了快速应用程序开发。控件本质上是封装了外观（UI）、行为（逻辑）和数据状态的可复用组件，运行时以对象形式存在，遵循COM模型。每个控件暴露属性（Property）、方法（Method）和事件（Event），构成PME编程范式。从硬编码填充 → 数组缓存 → 数据库绑定 → 虚拟化加载 → 双向同步，VB6 列表控件的应用已远远超出其原始设计范畴。
VB6鼠标滚轮增强DLL动态库实战应用
在Visual Basic 6.0（VB6）这一经典开发环境中，尽管其原生功能强大且易于上手，但在面对操作系统底层交互或需要扩展IDE行为时，往往依赖外部动态链接库（DLL）来实现更高级的功能。DLL作为Windows平台的核心模块化机制，允许开发者将可重用的代码封装为独立的二进制文件，供多个应用程序调用。VB6通过Declare语句支持对DLL中函数的声明和调用，从而实现与系统API或其他第三方库的无缝集成。
基于VB6的Excel数据查询系统开发与实现
在信息化系统开发的早期阶段，Visual Basic 6.0（简称VB6）凭借其直观的IDE环境和事件驱动编程模型，成为企业级桌面应用开发的核心工具之一。尤其在处理Office自动化任务时，VB6通过COM接口无缝调用Excel应用程序，实现数据读写、报表生成与批量处理等功能，展现出极强的集成能力。本章将系统介绍VB6在Excel自动化中的技术定位，解析其通过对象模型实现跨进程控制的基本原理，并探讨为何至今仍有大量金融、制造等行业的遗留系统依赖该技术栈。
VB基础类

7,789

社区成员

197,583

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章