ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 求助 急急急 文件汇总 将文件夹中的所有工作簿的特定行 汇总做不同工作表中

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-1-20 15:59 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
说明 : 将文件夹的所有工作薄中(实际数量上千个,附件中只列了10个)的A31、A79、A139、A220、A343、A514、A742、A1039、A1408、A1867、A2449、A3127、A3961,汇总到名"数据处理“工作薄中的sheet1~13中的b列,并对B列进行分列(按空格处理),也就说 所有工作薄的A31放到sheet1中B列,A79放到sheet2中B列,A220放到sheet3中B列,依次类推。

附件—数据处理.rar

846.61 KB, 下载次数: 28

TA的精华主题

TA的得分主题

发表于 2018-1-20 16:28 | 显示全部楼层
Option Explicit

Sub test()
  Dim pos, filename(), n, arr, brr, sht, i, j
  pos = Array(31, 79, 139, 220, 343, 514, 742, 1039, 1408, 1867, 2449, 3127, 3961)
  If Not getfilename(filename, ThisWorkbook.Path, ".csv") Then Exit Sub
  Application.ScreenUpdating = False
  For Each sht In Sheets
    Sheets(sht.Name).Cells.ClearContents
  Next
  For i = 1 To UBound(filename)
    Open filename(i) For Input As #1
    arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
    Close #1
    n = n + 1
    For j = 0 To UBound(pos)
      brr = Split(arr(pos(j) - 1))
      With Sheets("sheet" & j + 1)
        .Cells(n + 1, "b").Resize(, UBound(brr) + 1) = brr
      End With
  Next j, i
  Application.ScreenUpdating = True
End Sub

Function getfilename(filename, pth, mark) As Boolean
  Dim f, n
  If Right(pth, 1) <> "\" Then pth = pth & "\"
  f = Dir(pth & "*.*")
  Do While Len(f) > 0
    If LCase(Right(f, Len(mark))) = LCase(mark) Then
      n = n + 1: ReDim Preserve filename(1 To n)
      filename(n) = pth & f
    End If
    f = Dir
  Loop
  If n > 0 Then getfilename = True
End Function

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-20 16:35 | 显示全部楼层

十分感谢!!! 测试了一下 何止是完美 简直就是完美!!!再次膜拜 再次感谢!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-22 17:51 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 18831320853 于 2018-1-22 17:53 编辑

再次请教一下 ,为什么当文件夹中有1000多个工作薄的时候  和有10个工作簿的时候(1000个中的前10个)  汇总的数据不一样,能不能把选出来的数据变成数值型式的

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-22 18:24 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
一把小刀闯天下 发表于 2018-1-20 16:28
Option Explicit

Sub test()

再次请教一下,为啥放文件夹中有1000多个(或者3000多个)工作簿时,和有10个工作薄(1000个中的前10个)筛选出来的数据不一样啊?另外我想把筛选出来的数据变成数值格式,如何操作

TA的精华主题

TA的得分主题

发表于 2018-1-22 20:32 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
18831320853 发表于 2018-1-22 18:24
再次请教一下,为啥放文件夹中有1000多个(或者3000多个)工作簿时,和有10个工作薄(1000个中的前10个)筛选 ...

没看明白。如果只有1个csv文件(就是你说的工作簿,其实就是一个文本文件),那13个工作表中都会有1条数据,1000多个csv文件当然就是每个工作表中各有1000多条数据。于是当有10个csv文件时每个工作表就有10条数据。
1000多个文件和10个文件汇总肯定是不一样的,前十个当然也可以是不一样的。你的前十按什么条件排序的,大小、创建时间、文件名,,,?如果能确定可以在处理时先按某种规则先对需要处理的文件名做一个排序,但我觉得意义不大,如果是必须的可以考虑做些预处理。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-22 21:11 | 显示全部楼层
一把小刀闯天下 发表于 2018-1-22 20:32
没看明白。如果只有1个csv文件(就是你说的工作簿,其实就是一个文本文件),那13个工作表中都会有1条数 ...

我的意思  就是这1000个csv文件是按照文件名排序的   所以筛选出来的数据也是排序的,比如sheet1中的汇总各个a31的数据  也是按csv文件名自动排序的

TA的精华主题

TA的得分主题

发表于 2018-1-22 21:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
'按文件名做了一下排序(字符升序),再试一下

Option Explicit

Sub test()
  Dim pos, filename(), n, arr, brr, sht, i, j, crr, temp
  pos = Array(31, 79, 139, 220, 343, 514, 742, 1039, 1408, 1867, 2449, 3127, 3961)
  If Not getfilename(filename, ThisWorkbook.Path, ".csv") Then Exit Sub
  Application.ScreenUpdating = False
  For Each sht In Sheets
    Sheets(sht.Name).Cells.ClearContents
  Next
  ReDim crr(1 To UBound(filename), 1 To 2)
  For i = 1 To UBound(filename)
    crr(i, 1) = filename(i)
    j = Split(filename(i), "\")
    crr(i, 2) = j(UBound(j))
  Next
  temp = crr
  Call msort(crr, temp, 1, UBound(filename), 1, 2, 2)
  For i = 1 To UBound(filename)
    filename(i) = crr(i, 1)
  Next
  For i = 1 To UBound(filename)
    Open filename(i) For Input As #1
    arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
    Close #1
    n = n + 1
    For j = 0 To UBound(pos)
      brr = Split(arr(pos(j) - 1))
      With Sheets("sheet" & j + 1)
        .Cells(n + 1, "b").Resize(, UBound(brr) + 1) = brr
      End With
  Next j, i
  Application.ScreenUpdating = True
End Sub

Function getfilename(filename, pth, mark) As Boolean
  Dim f, n
  If right(pth, 1) <> "\" Then pth = pth & "\"
  f = Dir(pth & "*.*")
  Do While Len(f) > 0
    If LCase(right(f, Len(mark))) = LCase(mark) Then
      n = n + 1: ReDim Preserve filename(1 To n)
      filename(n) = pth & f
    End If
    f = Dir
  Loop
  If n > 0 Then getfilename = True
End Function

Function msort(arr, temp, first, last, left, right, key)
  Dim i, j, k, kk, mid
  If first <> last Then
    mid = Int((first + last) / 2)
    msort arr, temp, first, mid, left, right, key
    msort arr, temp, mid + 1, last, left, right, key
    i = first: j = mid + 1: k = first
    While i <= mid And j <= last
      If arr(i, key) <= arr(j, key) Then '改成>=就是降序
        For kk = left To right: temp(k, kk) = arr(i, kk): Next
        k = k + 1: i = i + 1
      Else
        For kk = left To right: temp(k, kk) = arr(j, kk): Next
        k = k + 1: j = j + 1
      End If
    Wend
    While i <= mid
      For kk = left To right: temp(k, kk) = arr(i, kk): Next
      k = k + 1: i = i + 1
    Wend
    While j <= last
      For kk = left To right: temp(k, kk) = arr(j, kk): Next
      k = k + 1: j = j + 1
    Wend
    For i = first To last
      For j = left To right
        arr(i, j) = temp(i, j)
    Next j, i
  End If
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-23 10:14 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
一把小刀闯天下 发表于 2018-1-22 21:29
'按文件名做了一下排序(字符升序),再试一下

Option Explicit

做了排序还是无法正确的筛选出来 ,筛选出的数据是乱的,您看要是方便的话,你给我看一下原始数据,这是网盘的下载连接https://pan.baidu.com/s/1dHizhS1,十分感谢!!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-1-24 08:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
18831320853 发表于 2018-1-23 10:14
做了排序还是无法正确的筛选出来 ,筛选出的数据是乱的,您看要是方便的话,你给我看一下原始数据,这是 ...

能不能给我解答一下 ,比较急用
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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