字典+数据循环查询

爱很简单

大神帮助优化优化，主要有两个问题：一是出现错误“内存溢出”；二是运行速度相当的慢！！！！！！！！！需要80多秒
    数据量太大了，数据一、数据二中的数据删除了，要不然上传不了。。。。。。。。。。。。。

   谢谢！！！！！！！！！！！！！！！！！！！！！！！！！！

rardge2015

这是网络上搜索的 SumIFS 使用介绍：
https://baijiahao.baidu.com/s?id=1610767784906967531&wfr=spider&for=pc

附件改成使用 SUMIF 及 SUMIFS 了。

hfwufanhf2006

你很勤奋啊，最近总看到你发帖。
数据要上传大点的，几十几百行的数据，随便哪种算法都很快，看不出差距。少说也要5000-1万行的数据才好看出效率差别。

hfwufanhf2006

我下载看了下，不知道你要干什么，你什么也没说。不会是要我去看你以前的发帖吧？

爱很简单

hfwufanhf2006 发表于 2019-10-8 15:41
你很勤奋啊，最近总看到你发帖。
数据要上传大点的，几十几百行的数据，随便哪种算法都很快，看不出差距。 ...

  呵呵，不是勤奋，是工作需要，本来数据是很大的，传不上。。。。。。只能穿1M以内的。

爱很简单

hfwufanhf2006 发表于 2019-10-8 15:45
我下载看了下，不知道你要干什么，你什么也没说。不会是要我去看你以前的发帖吧？

数据一、数据二中很多数据都被我删除了，数据实在是太大了。。。。。

hfwufanhf2006

爱很简单 发表于 2019-10-8 15:45
呵呵，不是勤奋，是工作需要，本来数据是很大的，传不上。。。。。。只能穿1M以内的。

  你要写点具体要求，我不知道你要干什么。
  你文件中是有一段代码，我运行了，目前的数据量只要4.5秒，我觉得这也很快了。如果你的数据量是几十万行那种，可能还是sql查询会更快些，字典不清楚，需要实际运行才知道。

爱很简单

hfwufanhf2006 发表于 2019-10-8 15:50
你要写点具体要求，我不知道你要干什么。
  你文件中是有一段代码，我运行了，目前的数据量只要4.5秒 ...

附件太大了，传不上去，能不能加您的QQ?

hfwufanhf2006

爱很简单 发表于 2019-10-8 15:58
附件太大了，传不上去，能不能加您的QQ?

我不用qq，你就简单说点你要求我大致能看懂就行了。
   我浏览下你代码，大概是对符合结果表的名称进行某种处理，好像是求和之类的，因为你代码是：
       cr(m, 10) = cr(m, 10) + br(i, 2) / 10000 ' 我感觉是按照万元来统计数字之类的；
   我先提点建议：
       1、不要一次性把数据源全部装入数组，如果是几十万行数据，占用内存会很大。因为你的源数据肯定都是需要扫描一遍的，先装入内存与一次性单元格扫描没有本质差别，反正都是需要读一次数据的，时间是一样的。差别在于不能反复读取单元格，反复读取单元格会很浪费时间，反复读数组则会节省很多，重要的是要尽可能避免反复读取；
       2、字典也是可以多字段记录信息的，就是常说的“一对多”，需要借助数组实现。大致的方法是：
            （临时写的，不一定能用，思路肯定是这样的）
            dim arr            dim arr1
            for i = 1 To [a1000000].end(3).row
                arr(1) =trim(cells(i, 1))
                arr(2) = cells(i,2)
                arr(3) = cells(i,3)
               If d.exists(trim(cells(i, 1))) then
                  arr1 = d.Item((trim(cells(i, 1))))   '读出字典已存在的数据
                  arr(2) = arr(2) + arr1(2)      '将字典数据与当前数据累加
                  arr(3) = arr(3) + arr1(3)
               endif
               d(trim(cells(i, 1))) = arr  '重新写入字典，如果关键字在字典不存在，则在字典新建关键字数据
            next i
            注意看，cells(i,1)是关键字，cells(i,2),cells(i,3)是数据，先过渡存放在数组arr中，然后将其装入字典，就能实现一对多。这应该比你的代码节省了一个环节。我看你是先把相同类别的数据据一条条存入临时数组，然后再来一次求和。上述方法可以一次性完成求和过程；
      3、Sql查询也是很高效的查询方法，至于与字典比较谁更快，这个说不好，我个人倾向于认为sql更快。重点不在于速度，而是sql查询更加简单，基本结构是：
          Dim Cn As Object          Dim Rec As Object
          Dim fanSql As String
          Set Cn = CreateObject("adodb.connection")
          Set Rec = CreateObject("ADODB.Recordset")
          Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='excel 12.0;hdr=yes;imex=1';Data Source=" & ThisWorkbook.FullName
          fanSql = "select 字段名,sum(求和字段1),sum(求和字段2) from [表单名称$] group by 字段名"
         Set Rec = Cn.Execute(fanSql)    '执行sql查询
         While Not Rec.EOF               '读取结果
           s1 = Rec.Fields(0).Value
           s2 = Rec.Fields(1).Value
           s3 = Rec.Fields(2).Value

           把对查询结果进行处理的代码都写在这里

           Rec.MoveNext
         Wend

         明显可以看出，sql简单高效，只需要一条select语句就搞定了一切。当然，后续对查询结果的处理代码还是要写的；

rardge2015

仅仅是针对一个表进行查询，没必要遍历Sheets，然后运行时间就降下来了。
如果你的数据一、数据二每列标题修改好（不能重复），用SQL方式会更快。
附件中，我修改的代码在 模块1。

1. Private Sub jigouhuizong_old()
   
2.     ' 变量定义最好集中在过程顶部，不要在程序中间定义，并不会节省内存，却不方便阅读和维护代码
   
3.     ' 另外，有些变量并没有定义哦！
   
4.     ' 建议在 工具 - 选项 - 编辑器 中选中 “要求变量声明”
   
5.     Dim dClk As Date
   
6.     Dim ar As Variant
   
7.     Dim br()
   
8.     Dim cr
   
9.     Dim i As Long
   
10.     Dim n As Long
    
11.     Dim m As Long
    
12.     Dim d As Object
    
13.    
    
14.     dClk = Timer()
    
15.     Application.ScreenUpdating = False
    
16.    
    
17.     'Set d = CreateObject("scripting.dictionary") ' 这句多余，因为在后面重复定义了。
    
18.    
    
19.     With Sheets("结果")
    
20.         n = .Cells(Rows.Count, "A").End(xlUp).Row
    
21.         If n < 13 Then Exit Sub
    
22.         Set d = CreateObject("scripting.dictionary") ' 建议保留这句，删除上面的字典定义
    
23.         For i = 13 To n
    
24.             d(Trim(.Range("A" & i).Value)) = ""
    
25.         Next
    
26.     End With
    
27.    
    
28.     cr = Sheets("结果").[a13].Resize(d.Count, 47) ' 不知道实际需求，是否有必要这么大？
    
29.    
    
30.     ''---------------------------------------------
    
31.     '' 既然只需要查询“数据一”，就不要访问所有Sheets
    
32.     '' 仅仅是这个修改，就把运行时间降下来了，看图片。
    
33.     ''---------------------------------------------
    
34.     dz = 48
    
35.     hs = 19
    
36.     qt = 28
    
37.    
    
38.     ' 从程序分析，仅仅处理 3 列数据，但却读取了 48 列到内存
    
39.     ' 可以考虑用三个数组，分别读取 1 列（DZ、HS、QT）
    
40.     ar = Sheets("数据一").Range("a1").CurrentRegion
    
41.    
    
42.     For Each k In d.keys
    
43.         n = 0
    
44.         m = m + 1
    
45.         ReDim br(1 To 100000, 1 To 6)
    
46.         
    
47.         For i = 3 To UBound(ar)
    
48.             If Trim(ar(i, dz)) = k Then
    
49.                 n = n + 1
    
50.                 br(n, 1) = ar(i, dz)
    
51.                 br(n, 2) = ar(i, hs)
    
52.                 br(n, 3) = ar(i, qt)
    
53.             End If
    
54.         Next i
    
55.         
    
56.         For i = 1 To n
    
57.             cr(m, 10) = cr(m, 10) + br(i, 2) / 10000
    
58.             
    
59.             If Trim(br(i, 3)) > 120 Then
    
60.                 cr(m, 12) = cr(m, 12) + br(i, 2) / 10000
    
61.             End If
    
62.         Next i
    
63.     Next k
    
64.    
    
65.     With Sheets("结果")
    
66.         ws = .Cells(Rows.Count, 1).End(xlUp).Row + 3
    
67.         Range("a13:i" & ws).Borders.LineStyle = xlNone
    
68.         
    
69.         .[a13].Resize(m, 47) = cr
    
70.         .[a13].Resize(m, 47).Borders.LineStyle = 1
    
71.     End With
    
72.    
    
73.     Erase ar: Erase br: Erase cr
    
74.     Set d = Nothing
    
75.    
    
76.     Application.ScreenUpdating = True
    
77.     dClk = Timer() - dClk
    
78.     MsgBox "查询成功！！！用了" & Format(dClk, "#,##0.0000s") & "时间"
    
79. End Sub

复制代码

爱很简单

速度太快了，谢谢您。。。。。。。。。。。。。。。。