求助几十万数据的处理

ychh_wy

原帖由 zhaogang1960 于 2011-3-7 14:47 发表

试试看
Sub 宏1()
    Dim d As Object, arr, brr(), i&
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("昨日").Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        d( ...

几十万数据用字典不行
查询代码
SELECT A.名称,A.今日,B.值,A.今日-B.值 FROM [今日$] A LEFT JOIN  [昨日$] B ON (A.名称=B.名称)
变化最大值
SELECT TOP 1 A.名称,A.今日,B.值,A.今日-B.值 FROM [今日$] A LEFT JOIN  [昨日$] B ON (A.名称=B.名称) ORDER BY ABS(A.今日-B.值) DESC

zhaogang1960

原帖由 ychh_wy 于 2011-3-9 20:55 发表

几十万数据用字典不行
查询代码
SELECT A.名称,A.今日,B.值,A.今日-B.值 FROM [今日$] A LEFT JOIN  [昨日$] B ON (A.名称=B.名称)
变化最大值
SELECT TOP 1 A.名称,A.今日,B.值,A.今日-B.值 FROM [今日$] A L ...

ado和数组比速度恐怕不行，刚才比较了135169行“昨日”和83969行“今日”，数据都很规范，数组仅用了3S，而ADO用了10S
代码如下：
Sub 宏1() ''字典法 '数据都放在本工作簿（xlsm）
tt = Timer
    Dim d As Object, arr, brr(), i&
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("昨日").Range("A1").CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 1)) = arr(i, 2)
    Next
    arr = Range("A2:B" & Range("A" & Cells.Rows.Count).End(xlUp).Row)
    ReDim brr(1 To UBound(arr), 1 To 2)
    For i = 1 To UBound(arr)
        If d.Exists(arr(i, 1)) Then
            brr(i, 1) = d(arr(i, 1))
            brr(i, 2) = arr(i, 2) - brr(i, 1)
        Else
            brr(i, 1) = "昨日无"
            brr(i, 2) = arr(i, 2)
        End If
    Next
    Range("c2").Resize(i - 1, 2) = brr
    MsgBox Timer - tt
End Sub
Sub Macro1() 'ADO法，数据都放在“100万数据处理.xlsx”，不能使用自连接，因为超过了65536
tt = Timer
    Dim cnn As Object, SQL$
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.Path & "\100万数据处理.xlsx"
    SQL = "SELECT A.名称,A.今日,B.值,A.今日-B.值 FROM [今日$] A LEFT JOIN  [昨日$] B ON (A.名称=B.名称)"
    [e2].CopyFromRecordset cnn.Execute(SQL)
    cnn.Close
    Set cnn = Nothing
    MsgBox Timer - tt
End Sub

zhaogang1960

下面是两个工作簿只保留了100行（昨日）、90行(今日)的附件，请测试：
100万数据处理.rar (29.53 KB, 下载次数: 18)

2011-3-9 21:43 上传

点击文件名下载附件