分表中含空行的汇总

太极拍天雄

hhxq001 发表于 2022-4-22 14:19
没有关闭汇总表的情况下，分表也无法打开，怎么给处理一下哦。见下图

我用WPS和office2021测试都可以正常运行，你把那些隐藏的带~“的缓存文件清除一下再试试看”

hhxq001

太极拍天雄 发表于 2022-4-22 15:44
我用WPS和office2021测试都可以正常运行，你把那些隐藏的带~“的缓存文件清除一下再试试看”

提取汇总后，我关闭汇总表，这些缓存文件就没有了呢，只要一提起分表数据就出现

太极拍天雄

hhxq001 发表于 2022-4-22 16:49
提取汇总后，我关闭汇总表，这些缓存文件就没有了呢，只要一提起分表数据就出现

加一句set wd = nothing 再试一下，我自己的excel测试均不会出现你这样的问题。

lsc900707

测试参考附件：

hhxq001

太极拍天雄 发表于 2022-4-22 18:47
加一句set wd = nothing 再试一下，我自己的excel测试均不会出现你这样的问题。

还是不行，只要点击提取按钮就出现，不知道为什么

opel-wong

hhxq001 发表于 2022-4-27 21:26
还是不行，只要点击提取按钮就出现，不知道为什么

这样试试看，

jjmysjg

hhxq001 发表于 2022-4-27 21:26
还是不行，只要点击提取按钮就出现，不知道为什么

应当可以的，是不是你的机器内存小，运行的慢呀

ykcbf1100

代码重写，速度上没提升，只是感觉看上去舒服一点。

ykcbf1100

1. Sub ykcbf()           '//2025.3.15
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim tm: tm = Timer
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set fso = CreateObject("Scripting.FileSystemObject")
   
7.     p = ThisWorkbook.Path & ""
   
8.     On Error Resume Next
   
9.     ReDim brr(1 To 10 ^ 4, 1 To 7)
   
10.     For Each f In fso.GetFolder(p).Files
    
11.         If LCase$(f.Name) Like "*.xls*" Then
    
12.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
13.                 Set wb = Workbooks.Open(f, 0)
    
14.                 arr = wb.Sheets("工资").UsedRange
    
15.                 wb.Close 0
    
16.                 For i = 3 To UBound(arr)
    
17.                     If arr(i, 1) <> "" Then
    
18.                         s = arr(i, 1)    '//条件
    
19.                         If Not d.Exists(s) Then
    
20.                             m = m + 1
    
21.                             d(s) = m
    
22.                             brr(m, 1) = arr(i, 1)
    
23.                             brr(m, 3) = arr(i, 2)
    
24.                             For j = 4 To UBound(arr, 2)
    
25.                                 brr(m, j + 1) = arr(i, j)
    
26.                             Next
    
27.                         Else
    
28.                             r = d(s)
    
29.                             For j = 4 To UBound(arr, 2)
    
30.                                 brr(r, j + 1) = brr(r, j + 1) + arr(i, j)
    
31.                             Next
    
32.                         End If
    
33.                     End If
    
34.                 Next
    
35.             End If
    
36.         End If
    
37.     Next
    
38.     With Sheets("汇总")
    
39.         .UsedRange.Offset(2) = Empty
    
40.         .Range("a3").Resize(m, 7) = brr
    
41.     End With
    
42.     Set d = Nothing
    
43.     Application.ScreenUpdating = True
    
44.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & "秒！"
    
45. End Sub
    
46. 
    

复制代码

shiruiqiang

ykcbf1100 发表于 2025-3-15 07:45

速度快的话，应该是sql语句