求助按条件分类汇总

Justin-2016

求助按条件分类汇总.zip (19.79 KB, 下载次数: 17)

2018-8-16 12:05 上传

点击文件名下载附件

不知道为什么

论坛类似代码很多，自己搜索下

Justin-2016

我只知道此问题用SQL比较容易实现，但具体代码不知道怎么写。

ykqrs

1. Sub qq()
   
2. Dim d, arr, p$, ws, r%, i%
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Cells.Clear
   
7. Sheets("清单明细").Cells.Copy [a1]
   
8. Columns("f").Insert
   
9. p = ThisWorkbook.Path & "\任务表.xlsx"
   
10. Set ws = Workbooks.Open(p)
    
11. With ws.Sheets("任务")
    
12. r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
13. arr = .Range("b5:f" & r)
    
14. For i = 1 To UBound(arr)
    
15. d(arr(i, 1)) = d(arr(i, 1)) & arr(i, 4) & "+" & arr(i, 5)
    
16. Next
    
17. ws.Close
    
18. End With
    
19. For i = 4 To [b65536].End(xlUp).Row
    
20. If d.exists(Cells(i, 2).Value) Then
    
21. Cells(i, 5) = Cells(i, 5).Value * Val(Split(d(Cells(i, 2).Value), "+")(0))
    
22. Cells(i, 6) = Split(d(Cells(i, 2).Value), "+")(1)
    
23. End If
    
24. Next
    
25. Columns("b").Delete
    
26. Application.ScreenUpdating = True
    
27. Application.DisplayAlerts = True
    
28. End Sub
    

复制代码

ykqrs

求助按条件分类汇总.zip (27.6 KB, 下载次数: 10)

2018-8-16 13:32 上传

点击文件名下载附件

代码又在审核，看附件

Justin-2016

ykqrs 发表于 2018-8-16 13:29

清单汇总表中的日期列字段目前是空白的，填上字段后执行代码后又变空白了，请大神指点要解决此问题代码该如何修改,谢谢！

ykqrs

求助按条件分类汇总1.zip (27.91 KB, 下载次数: 4)

2018-8-16 15:16 上传

点击文件名下载附件

ykqrs

求助按条件分类汇总1.zip (27.91 KB, 下载次数: 10)

2018-8-16 15:17 上传

点击文件名下载附件