ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 求助如何汇总多文件的指定区域,非空内容

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-11-19 00:02 | 显示全部楼层 |阅读模式
大神们,

    小白日常工作需要,能否用VBA有效解决?  先谢谢了!
    能否实现,一键提取xltx格式的多文件非空内容,提取订单的8行至45行内容,A列到E列
    遇到空行就不提取!  因为每天订单不可能整个8-45行都有满满的内容,谢谢!


11.11.rar

49.05 KB, 下载次数: 4

TA的精华主题

TA的得分主题

发表于 2018-11-19 17:40 | 显示全部楼层
两个思路:
1、让VBA后台自动挨个打开每个需要读取数据的文件,按规则读取即可
2、通过sql 的方式把数据源表作为数据库在不打开表格的状态下读取内部数据。
论坛上有类似的案例,可以搜搜看看

TA的精华主题

TA的得分主题

发表于 2018-11-19 18:40 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
要合并吗? 这个简单

TA的精华主题

TA的得分主题

发表于 2018-11-19 18:59 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Dim arr(), s&
Sub 多簿多表合并为一表()
   Dim MyPath, MyName, AWbName
    Dim wb As Workbook, WbN As String
    Dim G As Long
    Dim Num As Long
    Dim BOX As String
    bth = Val(Application.InputBox("请输入表头占据了的行数:", "拆分表格", "1"))
    bw = Val(Application.InputBox("请输入表尾行数:", "拆分表格", "0"))
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    MyPath = ThisWorkbook.Path
  s = 0
  Zdir ThisWorkbook.Path
For Each hhl In arr
    If hhl <> "" Then
    MyName = Dir(hhl)
    AWbName = ThisWorkbook.Name
        If MyName <> AWbName And MyName <> "" Then
            Set wb = Workbooks.Open(hhl)
            With Workbooks(1).ActiveSheet
             For G = 1 To wb.Sheets.Count
                tqgzb = wb.Sheets(G).Name
                lh = wb.Sheets(G).UsedRange.Columns.Count + wb.Sheets(G).UsedRange.Column - 1
                 hh = wb.Sheets(G).Range("a7").End(xlDown).Row
                  k = k + 1
                 If k = 1 Then
                   wb.Sheets(G).Range("a1").Resize(hh - bw, lh).Copy .Cells(.Range("a65536").End(xlUp).Row + n, 1)
                   hh1 = Workbooks(1).ActiveSheet.UsedRange.Rows.Count + Workbooks(1).ActiveSheet.UsedRange.Row - 1
                 n = (n + 1) ^ 0
                 Else
                 If hh > 1 Then
                 wb.Sheets(G).Range("a" & bth + 1).Resize(hh - bw - bth, lh).Copy .Cells(.Range("a65536").End(xlUp).Row + n, 1)
                 End If
                 n = (n + 1) ^ 0
                 End If
                Next
                wb.Close False
            End With
        End If

  End If
Next
    ActiveSheet.Name = "合并结果"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    msgbox "合并完毕!"
End Sub
Sub Zdir(P)
Set Fso = CreateObject("scripting.filesystemobject")
For Each f In Fso.GetFolder(P).Files
If f Like "*.xl*" Then
    s = s + 1
ReDim Preserve arr(1 To s)
    arr(s) = f
    End If
Next
For Each m In Fso.GetFolder(P).SubFolders
    Zdir m
Next
End Sub


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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