ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2010|回复: 10

[求助] 不连续列汇总,只汇总包含关键字子文件夹的文件

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-3-15 15:18 | 显示全部楼层 |阅读模式
不连续列汇总已经解决现在就是要解决文件夹内所有包含“月”关键字的子文件夹下的所有文件的数据

在此先谢过各位老师

不连续列汇总.rar

141.15 KB, 下载次数: 13

TA的精华主题

TA的得分主题

发表于 2019-3-15 15:20 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
那就遍历文件夹再做个判断呗,论坛代码很多

TA的精华主题

TA的得分主题

发表于 2019-3-15 15:30 来自手机 | 显示全部楼层
可有偿解决你的问题,联系电话139-3580-1684

TA的精华主题

TA的得分主题

发表于 2019-3-15 15:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
这种求助你是怎么开的出价格的呢?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-15 16:01 | 显示全部楼层
不知道为什么 发表于 2019-3-15 15:20
那就遍历文件夹再做个判断呗,论坛代码很多

理论我懂,技术还欠火候,只能做一些简单的修改

TA的精华主题

TA的得分主题

发表于 2019-3-15 16:06 | 显示全部楼层
  1. Sub hz()
  2.   Application.ScreenUpdating = False
  3.   Dim brr(), arr, i&, s&
  4.   Dim fso As Object
  5.   Set fso = CreateObject("scripting.filesystemobject")
  6.   Set f1 = fso.getfolder(ThisWorkbook.Path)
  7.   s = 1
  8.   For Each aa In f1.subfolders
  9.     If aa.Name Like "*月" Then
  10.       For Each bb In aa.Files
  11.         With GetObject(bb.Path)
  12.           arr = .Sheets(1).Range("a33:R" & .Sheets(1).[a33].End(xlDown).Row)
  13.           For i = 1 To UBound(arr)
  14.             ReDim Preserve brr(1 To 9, 1 To s)
  15.             If arr(i, 18) <> "" Then
  16.               brr(1, s) = arr(i, 1): brr(2, s) = arr(i, 2): brr(3, s) = arr(i, 3): brr(4, s) = arr(i, 4): brr(5, s) = arr(i, 6): brr(6, s) = arr(i, 7): brr(7, s) = arr(i, 8): brr(8, s) = arr(i, 10): brr(9, s) = arr(i, 18)
  17.               s = s + 1
  18.             End If
  19.            Next
  20.            .Close False
  21.            Erase arr
  22.         End With
  23.       Next
  24.     End If
  25.   Next
  26.   Range("A4:I200").ClearContents
  27.   [a4].Resize(UBound(brr, 2), 9) = Application.Transpose(brr)
  28.   Application.ScreenUpdating = True
  29. End Sub

复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-3-15 16:07 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-15 16:40 | 显示全部楼层

chxw68老师都不知道帮了我多少次了,谢谢

TA的精华主题

TA的得分主题

发表于 2019-3-15 16:42 | 显示全部楼层
Sub a()
Dim cnn, r%, sql$, myf$
Dim RS, bt, i
Set cnn = CreateObject("adodb.connection")
Set RS = CreateObject("adodb.Recordset")
For i = 1 To 9
    bt = bt & Cells(3, i) & ","
Next
bt = Left(bt, Len(bt) - 1)
myf = Dir(ThisWorkbook.Path & "\" & [b2] & "\*.xls*")
Do While myf <> ""
    sql = sql & " select " & bt & " from [Excel 12.0;Database=" & ThisWorkbook.Path & "\" & [b2] & "\" & myf & "].[Sheet1$a32:z] union all "
    myf = Dir()
Loop
sql = Left(sql, Len(sql) - 11)
cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & ThisWorkbook.FullName
RS.Open sql, cnn, 1, 1
'For i = 0 To RS.Fields.Count - 1
'   Cells(1, i + 1) = RS.Fields(i).Name
'Next
Range("a4").CopyFromRecordset RS
RS.Close
cnn.Close
Set RS = Nothing
Set cnn = Nothing
End Sub


TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-16 00:33 | 显示全部楼层
魂断蓝桥 发表于 2019-3-15 16:42
Sub a()
Dim cnn, r%, sql$, myf$
Dim RS, bt, i

谢谢魂断蓝桥老师,不过你好像理解错误了,我是要 汇总文件夹内所有包含“月”关键字的子文件夹下的所有文件的数据,不过感觉好像你的代码速度很快啊
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 02:02 , Processed in 0.051417 second(s), 14 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表