几万行TXT文本记录如何快速除重并乱序排列呢？

camry82 2013-07-20 09:37:11
几万行TXT文本记录如何快速除重并乱序排列呢？

我现在用的方法：
Private Sub Command1_Click()
Dim strtmp
Dim i
Open App.Path & "\" & Text1.Text For Binary As #1
strtmp = Split(Input(LOF(1), 1), vbCrLf)
For i = 0 To UBound(strtmp) - 1
List1.AddItem strtmp(i)
Next
Close #1
List1.ListIndex = 0

List2.Clear

Dim e As Integer
Dim t As Integer
For e = 0 To List1.ListCount - 1
Randomize
t = Int(Rnd * List1.ListCount)
List2.AddItem List1.List(t)
List1.RemoveItem (t)
If List1.ListCount = 0 Then Exit Sub
Next e
End Sub

Private Sub Command2_Click()
Dim i As Integer, j As Integer
Dim n As Integer
With List2
For i = 0 To .ListCount - 1
For j = .ListCount - 1 To i + 1 Step -1
If .List(j) = .List(i) Then
List2.RemoveItem j
End If
Next j
Next i
End With

List2.ListIndex = 0
For n = 0 To List2.ListCount - 1
If List2.List(n) = "" Then
' List2.RemoveItem n
End If
Next n

Open App.Path & "\" & Text1.Text For Output As #1
For i = 0 To List2.ListCount
Print #1, List2.List(i)
Next
Close #1

Text2.Text = List2.ListCount

End Sub

用这方法很慢，会卡死，有什么方法可以快速处理吗？请给下代码，谢谢了呀。
...全文
1475 45 打赏 收藏 转发到动态 举报
写回复
用AI写文章
45 条回复
切换为时间正序
请发表友善的回复…
发表回复
舉杯邀明月 2013-07-21
  • 打赏
  • 举报
 回复
即使相同数据量，运行结果也无法完全稳定。 因为跟CPU负荷状态有很大关系。 并且，GetTickCount()得到的时间，精度是很差的。
舉杯邀明月 2013-07-21
  • 打赏
  • 举报
 回复
我几次测试的结果表明，3W数据的时候，两种方法速度相当。 数据量越多，排序筛选相对更快。 但数据少些，用Dictionary对象处理就要快些。 把41F的图片，另存为 *.rar文件，打开就能解压我的测试源码。 里面也有编译好的 .exe程序。 有兴趣的可以试下。
舉杯邀明月 2013-07-21
  • 打赏
  • 举报
 回复
To: SupermanKing
　　我先前把你的“快排”和删除的代码，跟我用Dictionary对象进行处理的代码，重新组织了一个测试程序。
生成数据是用的你的方式。只是我修改了一下，但生成结果是相同的。
得出的初步结论是：
　　“快排”在把有序数据打乱后，排序时间明显增加。对“乱序”进行排序的时间基本就是有序数据的2倍。
　　排序后进行筛选，数据多时占明显优势。因为排序时间基本就是正比关系，而Dictionary对象的时间，是指数关系，这个指数是略大于2的，也就是耗时比“平方关系”的时间还多。
下图是我的一次测试结果：

你在26F的排序时间，那么多个“为０”的，我有点不明白。
是不是你的数据量不对啊？你38F的代码，看得出是1W条。
I'm Daniel Du 2013-07-21
  • 打赏
  • 举报
 回复
但觉厉
去圣西罗-为尤文喝彩 2013-07-21
  • 打赏
  • 举报
 回复
速度和CPU,RAM有关吧。AMD Phenom II X6 1090T +12GB，估计可以跑10秒内。
现在还是人类 2013-07-21
  • 打赏
  • 举报
 回复
引用 41 楼 Chen8013 的回复:
你在26F的排序时间，那么多个“为０”的，我有点不明白。 是不是你的数据量不对啊？你38F的代码，看得出是1W条。
那个时间是我屏蔽了具体过程只做一个排序过程得到的时间，所以才会有那么多 "0"，而且当时用的是插入法，呵呵 

Private Sub Command3_Click()
    Dim ReadArray() As String
    Dim lngArraySize As Long
    Dim strTmp As String
    Dim fs As Integer
    Dim row As Long
    Dim i As Long
    Dim j As Long
    Dim index As Long
    Dim iscompositor As Boolean
    List1.Clear
Dim savetime As Long
savetime = GetTickCount
    '========== 把文本文件以行为单位读入字符串数组 ==========
    row = 0
    ReDim ReadArray(row)
    fs = FreeFile
    Open App.Path & "\" & Text1.Text For Input As #fs
    Do While Not EOF(fs)
    Line Input #fs, strTmp
    ReadArray(row) = strTmp
    row = row + 1
    ReDim Preserve ReadArray(row)
    Loop
    Close #fs
    lngArraySize = row - 1
    ReDim Preserve ReadArray(lngArraySize)
Dim readfiletime As Long
readfiletime = GetTickCount

    '========== 对数组进行排序 ==========
    '冒泡法
    'Call compositor_ebullient(ReadArray)
Dim mpftime As Long
mpftime = GetTickCount
    '选择法
    'Call compositor_select(ReadArray)
Dim xzftime As Long
xzftime = GetTickCount
    '快速法
    Call compositor_quick(ReadArray, 0, lngArraySize)
Dim ksftime As Long
ksftime = GetTickCount
    '插入法
'    Call compositor_insert(ReadArray)
Dim crftime As Long
crftime = GetTickCount
    '希尔法
'    Call compositor_shell(ReadArray)
Dim xrftime As Long
xrftime = GetTickCount
    '========== 对数组进行除重 ==========
    '除重
    Call kill_repeated(ReadArray)
Dim ccftime As Long
ccftime = GetTickCount
    
Dim compositortime As Long
compositortime = GetTickCount
    '========== 将排序好的数组输出 ==========
    lngArraySize = UBound(ReadArray)
    For i = 0 To lngArraySize
        List1.AddItem ReadArray(i)
    Next i
Dim overtime As Long
overtime = GetTickCount
MsgBox "总耗时：" & overtime - savetime & " 毫秒" & vbCrLf & _
       "读文件：" & readfiletime - savetime & " 毫秒" & vbCrLf & _
       "冒泡法：" & mpftime - readfiletime & " 毫秒" & vbCrLf & _
       "选择法：" & xzftime - mpftime & " 毫秒" & vbCrLf & _
       "快速法：" & ksftime - xzftime & " 毫秒" & vbCrLf & _
       "插入法：" & crftime - ksftime & " 毫秒" & vbCrLf & _
       "希尔法：" & xrftime - crftime & " 毫秒" & vbCrLf & _
       "除重复：" & ccftime - xrftime & " 毫秒" & vbCrLf & _
       "加数据：" & overtime - compositortime & " 毫秒"
End Sub
现在还是人类 2013-07-20
  • 打赏
  • 举报
 回复
用你的代码测试一下，看看，我的机子就跑了20几秒 

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

' 需要引用：Microsoft Scripting Runtime
Private Sub Command1_Click()
   Dim objDict As New Dictionary
   Dim arrBuf() As String
   Dim arrOut() As String
   Dim arrIndex() As Long
   Dim i&, p&, m&, strTemp$
Dim savetime As Long
savetime = GetTickCount
   Open App.Path & "\" & Text1.Text For Binary As #1
   arrBuf = Split(Input(LOF(1), 1), vbCrLf)
   '筛选、除重
   p = -1
   m = UBound(arrBuf)
   ReDim arrOut(m)
   For i = 0 To m
      strTemp = arrBuf(i)
      If (Len(strTemp)) Then
         If (Not objDict.Exists(strTemp)) Then
            p = p + 1
            objDict.Add strTemp, p
            arrOut(p) = strTemp
         End If
      End If
   Next
   Close #1
   objDict.RemoveAll
   Set objDict = Nothing
   If (p = -1) Then
      MsgBox "没有内容。", vbExclamation
      Exit Sub
   End If
   '乱序输出
   ReDim arrIndex(p)
   For i = 0 To p
      arrIndex(i) = i
   Next
   Randomize
   m = p
   For i = 0 To p
      p = Rnd() * m
      List1.AddItem arrOut(arrIndex(p))
      arrIndex(p) = arrIndex(m)
      m = m - 1
   Next
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub

Private Sub Command2_Click()
    Dim test As String
    Dim i As Long
Dim savetime As Long
savetime = GetTickCount
    Open App.Path & "\" & Text1.Text For Output As #1
    For i = 1 To 100000
        test = String(8 - Len(Hex(i)), "0") & Hex(i)
        Print #1, test
    Next i
    Close #1
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub
现在还是人类 2013-07-20
  • 打赏
  • 举报
 回复
引用 2 楼 Chen8013 的回复:
10W数据，也就2秒左右： 
Option Explicit

' 需要引用：Microsoft Scripting Runtime
Private Sub Command1_Click()
   Dim objDict As New Dictionary
   Dim arrBuf() As String
   Dim arrOut() As String
   Dim arrIndex() As Long
   Dim i&, p&, m&, strTemp$
   
   Open App.Path & "\" & Text1.Text For Binary As #1
   arrBuf = Split(Input(LOF(1), 1), vbCrLf)
   '筛选、除重
   p = -1
   m = UBound(arrBuf)
   ReDim arrOut(m)
   For i = 0 To m
      strTemp = arrBuf(i)
      If (Len(strTemp)) Then
         If (Not objDict.Exists(strTemp)) Then
            p = p + 1
            objDict.Add strTemp, p
            arrOut(p) = strTemp
         End If
      End If
   Next
   Close
   objDict.RemoveAll
   Set objDict = Nothing
   If (p = -1) Then
      MsgBox "没有内容。", vbExclamation
      Exit Sub
   End If
   '乱序输出
   ReDim arrIndex(p)
   For i = 0 To p
      arrIndex(i) = i
   Next
   Randomize
   m = p
   For i = 0 To p
      p = Rnd() * m
      List1.AddItem arrOut(arrIndex(p))
      arrIndex(p) = arrIndex(m)
      m = m - 1
   Next
End Sub
你是不是打字打漏了，不是“2秒左右”是“20秒左右”吧，呵呵
舉杯邀明月 2013-07-20
  • 打赏
  • 举报
 回复
10W数据，也就2秒左右： 
Option Explicit

' 需要引用：Microsoft Scripting Runtime
Private Sub Command1_Click()
   Dim objDict As New Dictionary
   Dim arrBuf() As String
   Dim arrOut() As String
   Dim arrIndex() As Long
   Dim i&, p&, m&, strTemp$
   
   Open App.Path & "\" & Text1.Text For Binary As #1
   arrBuf = Split(Input(LOF(1), 1), vbCrLf)
   '筛选、除重
   p = -1
   m = UBound(arrBuf)
   ReDim arrOut(m)
   For i = 0 To m
      strTemp = arrBuf(i)
      If (Len(strTemp)) Then
         If (Not objDict.Exists(strTemp)) Then
            p = p + 1
            objDict.Add strTemp, p
            arrOut(p) = strTemp
         End If
      End If
   Next
   Close
   objDict.RemoveAll
   Set objDict = Nothing
   If (p = -1) Then
      MsgBox "没有内容。", vbExclamation
      Exit Sub
   End If
   '乱序输出
   ReDim arrIndex(p)
   For i = 0 To p
      arrIndex(i) = i
   Next
   Randomize
   m = p
   For i = 0 To p
      p = Rnd() * m
      List1.AddItem arrOut(arrIndex(p))
      arrIndex(p) = arrIndex(m)
      m = m - 1
   Next
End Sub
现在还是人类 2013-07-20
  • 打赏
  • 举报
 回复
用数组自己排序会比你这样快很多，还有就是ListBox对于大量的数据操作效率是很低的，可以考虑换个专门用于数据操作的控件来交互。
阳光地带 2013-07-20
  • 打赏
  • 举报
 回复
学习了，谢谢
现在还是人类 2013-07-20
  • 打赏
  • 举报
 回复
引用 32 楼 Chen8013 的回复:
我不是无意探讨，只是觉得“测试环境”跟实际应用的差别过大，没探讨价值。 再说，你始终在回避一个问题：数据筛选！ 这应该说是不能忽略的地方。 　　还有一个要说明的，我刚才忽然想到，我在6F贴图中，那个筛选数据的时间，是不正确的，它是包含读取数据的时间在内。我刚试了下单独的时间，用你的代码生成的数据，10Ｗ条，“筛选时间”是468 ms。
不是我回避什么问题，而是这根本就不是什么问题，先不说时候直接在排序过程里做数据筛选过程，就算独立循环一次去做筛选也不会要多久时间，看你的测试环境应该比我的要强很多了，我的还是好几年前的笔记本电脑，所以速度是差点，你那里跑十多秒的过程我这要二十多秒，不过就这种有差异的环境测试这种过程，我这的10W条数据排序+剔除重复也只用了 (排序)452 ms + (筛选)62 ms，你的是筛选时间就花了 468 ms，h还没有数据排序过程。 其实如果数据有了排序，赛选可以说很简单，看看这个过程 

Private Sub kill_repeated(strArray() As String)
    Dim max As Long, _
        min As Long, _
        i As Long, _
        j As Long, _
        count As Long, _
        strTmp As String
    max = UBound(strArray)
    count = max
    min = LBound(strArray)
    j = 0
    
    For i = min + 1 To max
        strTmp = strArray(i - 1)
        If Len(strTmp) = 0 Then
            strArray(i - 1) = strArray(i + j)
            j = j + 1
            i = i - 1
            count = count - 1
        Else
            If strArray(i - 1) = strArray(i + j) Then
                j = j + 1
                i = i - 1
                count = count - 1
            Else
                strArray(i) = strArray(i + j)
            End If
        End If
        If i >= count Then Exit For
    Next i
    ReDim Preserve strArray(count)
End Sub
这个赛选过程完全是基于排序好的数据进行筛选，所以根本不需要什么时间，我这里的10W条全反序数据被弄正序之后，只用了62 ms就完成了这种重复筛选。我测试的数据是这样来的。 

Private Sub Command2_Click()
    Dim test As String
    Dim i As Long
    Dim j As Long
Dim savetime As Long
savetime = GetTickCount
    Open App.Path & "\" & Text1.Text For Output As #1
    For i = 0 To 9999
        test = String(8 - Len(Hex(10000 - i)), "0") & Hex(10000 - i)
        For j = 1 To 10
            Print #1, test
        Next j
    Next i
    Close #1
MsgBox "耗时：" & GetTickCount - savetime & " 毫秒"
End Sub
nj_dobetter 2013-07-20
  • 打赏
  • 举报
 回复
大数据，我一般使用外排序算法
camry82 2013-07-20
  • 打赏
  • 举报
 回复
谢谢大家。。
ah_2056 2013-07-20
  • 打赏
  • 举报
 回复
引用 34 楼 Chen8013 的回复:
[quote=引用 30 楼 ah_2056 的回复:] [quote=引用 28 楼 Chen8013 的回复:] 看清楚，我说的是“读文件的方法”。 再者，你是对数据进行排序，没做“剔除重复数据”的工作。 我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。 并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。 我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。 还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。 我只是针对楼主的情况，给一个比较简单的方法来解决问题。
怎么都没人试过DICTIONAR对象啊。[/quote] 请问 DICTIONAR对象 是什么东东啊？ 如果你是少写了个Y的话，我2F的代码，难道不是用的它？ [/quote] 哦哦，我就说嘛，大数据情况下，查找，排序 ，DICTIONNARY是比较快的 ，有些时候快过SQL. 但是这些都是VB6里面的 ，不知道 .NET那个DICTIONARY和 哈希 速度怎么样 。
舉杯邀明月 2013-07-20
  • 打赏
  • 举报
 回复
引用 30 楼 ah_2056 的回复:
[quote=引用 28 楼 Chen8013 的回复:] 看清楚，我说的是“读文件的方法”。 再者，你是对数据进行排序，没做“剔除重复数据”的工作。 我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。 并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。 我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。 还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。 我只是针对楼主的情况，给一个比较简单的方法来解决问题。
怎么都没人试过DICTIONAR对象啊。[/quote] 请问 DICTIONAR对象 是什么东东啊？ 如果你是少写了个Y的话，我2F的代码，难道不是用的它？
bcrun 2013-07-20
  • 打赏
  • 举报
 回复
看到楼主用Listbox控件来处理大量字符串数组的需求就雷倒了：（）
舉杯邀明月 2013-07-20
  • 打赏
  • 举报
 回复
我不是无意探讨，只是觉得“测试环境”跟实际应用的差别过大，没探讨价值。 再说，你始终在回避一个问题：数据筛选！ 这应该说是不能忽略的地方。 　　还有一个要说明的，我刚才忽然想到，我在6F贴图中，那个筛选数据的时间，是不正确的，它是包含读取数据的时间在内。我刚试了下单独的时间，用你的代码生成的数据，10Ｗ条，“筛选时间”是468 ms。
现在还是人类 2013-07-20
  • 打赏
  • 举报
 回复
引用 28 楼 Chen8013 的回复:
看清楚，我说的是“读文件的方法”。 再者，你是对数据进行排序，没做“剔除重复数据”的工作。 我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。 并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。 我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。 还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。 我只是针对楼主的情况，给一个比较简单的方法来解决问题。
呵呵，既然你对“技术”本身无意探讨，我也就不多说
ah_2056 2013-07-20
  • 打赏
  • 举报
 回复
引用 28 楼 Chen8013 的回复:
看清楚，我说的是“读文件的方法”。 再者，你是对数据进行排序，没做“剔除重复数据”的工作。 我们都是用你的代码生成的数据来进行的测试，那个数据是没有重复的。 并且，是有序的，用你的排序方法进行排序，是“时间上”应该有特殊性的。 我对“快速排序”算法的看法是，适合数据比较多、但不适合数据非常之多的情况（比如几百Ｗ以上）。 还有最重要的一点：我没说我2F的这个方法是最快、或者最好的。 我只是针对楼主的情况，给一个比较简单的方法来解决问题。
怎么都没人试过DICTIONAR对象啊。
加载更多回复（25）
python文本分析的开源工具_重磅开源:TN文本分析语言
tn是desert(沙漠之鹰)和tan共同开发的一种用于匹配，转写和抽取文本的语言（DSL）。并为其开发和优化了专用的编译器。基于递归下降方法和正则表达式，能解析自然文本并转换为树和字典，识别时间，地址，数量等复杂序列模式。github地址：https://github.com/ferventdesert/tnpy0.设计理由字符串分析和处理几乎是每个员程序必备的工作，简单到分割类似"1,2,3,...
名企面试题
京东面试题： 1.说说值对象与引用对象的区别？ 2.谈谈你对反射机制的理解及其用途？ 3.ArrayList、Vector、LinkedList的区别及其优缺点？HashMap、HashTable的区别及其优缺点？ 3.列出线程的实现方式？如何实现同步？ 4.sql题,是一个图表，具体忘了 5.列出至少五种设计模式？用代码或UML类图描述其中两种设计模式的原理？ 6....
面试题之10亿正整数问题--完整解答
关于这个问题，经过这么久的讨论，两篇文章及大家的回复，已经比较很清楚了。这里就来完整的整理一下解答。其实本来已经整理得差不多了，不过很不幸，电脑忽然罢工，怎么也启动不了，然后又感冒了，所以一直到现在才开始做这个解答。 好了，不说这个了。下面进入正题。 这个题目来源于某公司的 面试题，是absolute同学在我的“面试题收集贴”中提出的，之后CMGS同学在回复中提到，腾讯今年的面试题中...
std中稳定排序算法_转载：在STL泛型算法中的排序函数sort内部使用的是哪种排序算法呢？...
转载：在STL泛型算法中的排序函数sort内部使用的是哪种排序算法呢？(2011-09-02 16:18:54)标签：杂谈当你有一个数据序列时，你最想做的操作之一就是排序。将数据排序使得它易于被人理解，而且排序是许多泛型算法的第一步－－即使是计算一系列数字的和这样的微末算法。每个编程系统都提供了几种形式的排序；标准C++运行库提供了6种！(或可能更多，这取决于你怎么数了。)他们有多么大的差异，并且...
大数据算法面试题
1、给定 a、b 两个文件，各存放 50 亿个 url，每个 url 各占 64 字节，内存限制是 4G，让你找出 a、b 文件共同的 url？ 1) 可以估计每个文件安的大小为 50G×64=320G，远远大于内存限制的 4G。所以不可能将其完全加载到内存中处理。考虑采取分而治之的方法。 2) 遍历文件 a，对每个 url 求取 ，然后根据所取得的值将 url 分别存储到 1...
VB基础类

7,762

社区成员

197,608

社区内容

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

加载中

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

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

+ 用AI写文章