VB 在大批量数据内去重(下百万条记录)

VB 在大批量数据内去重(上百万条记录)
要对上百万条记录进行去重有的还需要统计重复的个数

现在的去重方法是

方法一:

VB code

Set fs = CreateObject("Scripting.FileSystemObject")
    
    Set ts1 = fs.OpenTextFile("D:\b.txt", 1, True)

    ipstring1 = ""
    ipstring2 = ""
   
    Set f = fs.CreateTextFile("d:\d.txt", True)

    Do While Not ts1.AtEndOfStream
        ipstring1 = ts1.readline
        
              Set ts2 = fs.OpenTextFile("D:\d.txt", 1, True)

                If Not ts2.AtEndOfStream Then
            
                    ipstring2 = TextGetByFile(ts2.ReadAll)
                    
                    If InStr(ipstring2, ipstring1) > 0 Then
                    'If TimesInStr(ipstring2, ipstring1) > 0 Then
                    Else
                        f.WriteLine (ipstring1)
                    End If
                Else
            
                 f.WriteLine (ipstring1)
                
                End If
                ts2.Close
               Set ts2 = Nothing

    Loop

方法二:

VB code

    Set fs = CreateObject("Scripting.FileSystemObject")
    

    Set ts1 = fs.OpenTextFile("d:\b.txt", 1, True)
    
    ipstring1 = ""
    ipstring2 = ""
   
 
   Set f = fs.CreateTextFile("d:\dd.txt", True)
  
   Dim regEx, strTemp          ' 建立变量。
   Set regEx = New RegExp           ' 建立正则表达式。
   Dim blnMatche
   regEx.IgnoreCase = False         ' 设置是否区分字符大小写。
   regEx.Global = False           ' 设置全局可用性。
   regEx.MultiLine = True

    Do While Not ts1.AtEndOfStream
        ipstring1 = ts1.readline
        
               Set ts2 = fs.OpenTextFile("d:\dd.txt", 1, True)
                
                If Not ts2.AtEndOfStream Then
            
                    ipstring2 = ts2.ReadAll
                   
                    regEx.Pattern = ipstring1 & "$"
                    If regEx.test(ipstring2) Then
                    Else
                        f.WriteLine (ipstring1)
                    End If
                Else
            
                 f.WriteLine (ipstring1)
                
                End If
                ts2.Close
               Set ts2 = Nothing
    Loop

近十万条数据就得5分多钟实在是太恐怖了本人新请大虾们帮忙

数据的基本格式:

00-10-18-1A-32-E7,222.221.247.146
00-E0-4D-74-48-3C,112.116.79.22
00-21-97-9B-6A-DA,117.35.182.78
00-E1-04-10-2B-3F,120.68.42.6
00-1C-25-A8-56-09,222.80.105.26
00-E0-4C-C0-2A-9E,220.165.49.5
00-E0-4D-C5-A4-A0,121.26.202.34
40-61-86-99-B7-2E,61.183.248.94
6C-F0-49-74-AD-E2,124.117.227.22
00-1D-92-AC-95-A4,221.8.15.66
00-25-22-30-3D-81,221.214.141.217
00-1B-FC-02-3A-EC,124.118.169.214
00-E0-4C-F5-29-44,218.84.191.190
00-30-67-25-1C-FB,218.28.7.181
00-24-1D-0F-BA-11,116.53.189.18
00-24-1D-02-DD-10,218.28.234.226
00-1D-92-AF-2E-22,58.244.234.222
00-E0-4C-C0-02-40,202.97.146.228
00-1C-25-A8-8F-BC,222.243.18.17

基本上都是这样的寻求好的快的处理方法或算法

------解决方案--------------------
唉。。。。其实我给你的那个帖子里，已经有非常接近你需求的代码了，改改的话，应该就差不多了。。。

但看样子你非要等到一个完全与你需求一模一样的代码？所以我只能帮顶了。
------解决方案--------------------
用Collection,100万条不重复数据,27秒搞定.

VB code

Private Sub Command2_Click()
    Dim col As Collection
    Set col = New Collection

    Dim stream1 As TextStream
    Set stream1 = fso.OpenTextFile(fso.BuildPath(App.Path, "test.txt"), ForReading, False)
    
    Dim stream2 As TextStream
    Set stream2 = fso.OpenTextFile(fso.BuildPath(App.Path, "output.txt"), ForWriting, True)
    
    While Not stream1.AtEndOfStream
        Dim strLine As String
        strLine = stream1.ReadLine
        
        Dim vntValue As Variant
        vntValue = Empty
        
        ' 获取关键字对应的节点对象
        On Error Resume Next
        vntValue = col.Item(strLine)
        On Error GoTo 0
        
        If IsEmpty(vntValue) Then
            Call col.Add(Null, strLine)
            Call stream2.WriteLine(strLine)
        End If
    Wend
    
    Call stream1.Close
    Call stream2.Close
End Sub

VB 在大批量数据内去重(下百万条记录)

相关推荐