ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微视频教程 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 205|回复: 29

合并代码求修改

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-8-11 22:00 | 显示全部楼层 |阅读模式
本帖最后由 LWXT 于 2017-8-11 23:51 编辑

各位高手我在网上求得一合并文件夹下所有工作簿中第一个工作表的代码,非常好用。该代码合并后保留原工作表的公式、格式等,但是日常工作中有些表格保留公式,合并后出现错误。我是初学,求高手帮助修改下代码,使得合并后的工作表不包含原工作表的公式、格式。谢谢
代码如下: 详见附件 事例.zip (138.3 KB, 下载次数: 1)

事例2.zip

129.74 KB, 下载次数: 4

TA的精华主题

TA的得分主题

发表于 2017-8-11 22:35 | 显示全部楼层
修改, AK.Sheets(i).Range("a2:k" & aRow).CopyThisWorkbook.Sheets(1).Range("a" & tRow)
不用copy命令,用数组取单元格的值。

需要具体问题具体分析,没有附件就不便于研究学习了。

供参考。

评分

参与人数 1鲜花 +2 收起 理由
LWXT + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-8-11 23:12 | 显示全部楼层
有公式的合并最好用数组法改写。但是最好上传附件。

评分

参与人数 1鲜花 +2 收起 理由
LWXT + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-11 23:26 | 显示全部楼层
weiqigreen 发表于 2017-8-11 22:35
修改, AK.Sheets(i).Range("a2:k" & aRow).CopyThisWorkbook.Sheets(1).Range("a" & tRow)
不用copy命令 ...

非常感谢您的解答,我已上传了附件,麻烦您帮忙修改下,谢谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-11 23:44 | 显示全部楼层
lsc900707 发表于 2017-8-11 23:12
有公式的合并最好用数组法改写。但是最好上传附件。

非常感谢,已重新上传了附件,麻烦您修改下。谢谢

TA的精华主题

TA的得分主题

发表于 2017-8-12 00:21 | 显示全部楼层
LWXT 发表于 2017-8-11 23:26
非常感谢您的解答,我已上传了附件,麻烦您帮忙修改下,谢谢
  1. 'AK.Sheets(1).Range("A4:BL" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)   'A3指开始合并单元格位置,可据实修改,BL指列的宽度(64列),日常基本够用不用修改。
  2.          'weiqigreen:将上一句换成下面两句:
  3.          brr = AK.Sheets(1).Range("A4:E" & aRow)
  4.          ThisWorkbook.Sheets(1).Cells(tRow, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
复制代码
修改后的_事例2.rar (125.71 KB, 下载次数: 3)

评分

参与人数 1鲜花 +2 收起 理由
LWXT + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-8-12 01:09 | 显示全部楼层
LWXT 发表于 2017-8-11 23:44
非常感谢,已重新上传了附件,麻烦您修改下。谢谢

Sub 按钮1_单击()
   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer, arr()
   Application.ScreenUpdating = False        '冻结屏幕,以防屏幕抖动
   myPath = ThisWorkbook.Path & "\分表\"          '把文件路径定义给变量
   myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   Do While myFile <> ""                     '当指定路径中有文件时进行循环
      If myFile <> ThisWorkbook.Name Then
         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
          For i = 1 To AK.Sheets.Count
              With AK.Sheets(i)
                 aRow = .Range("a65536").End(xlUp).Row
                 arr = .Range("a2:i" & aRow).Value
                 tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1
                 ThisWorkbook.Sheets(1).Range("a" & tRow).Resize(UBound(arr), UBound(arr, 2)) = arr
               End With
         Next
         Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
      End If
      myFile = Dir                                   '找寻下一个*.xls文件
   Loop
   Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
   MsgBox "汇总完成,请查看!", 64, "提示"
End Sub

评分

参与人数 1鲜花 +2 收起 理由
LWXT + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-12 14:37 | 显示全部楼层

非常感谢您的帮助,经测试完全复合要求,但我认为: brr = AK.Sheets(1).Range("A4:E" & aRow) 中的A4:E 还是修改成 A4;BL 比较合适些,A4代表表头行数为3行从A4开始复制,BL代表汇总工作表的宽度,BL代表工作表有64列,一般工作表都超不过64列,这样汇总工作表就能当工具表使用了,任意工作表汇总只需根据实际修改表头行数(A4)一个参数即可(列宽64列基本不用修改)。这样通用性强一点,基本上任意工作表汇总只需根据表头行数修改一个参数即可(列宽基本都在BL即64列之内)。再次感谢您的帮助。

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-8-12 14:48 | 显示全部楼层
lsc900707 发表于 2017-8-12 01:09
Sub 按钮1_单击()
   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer, arr()
   A ...

非常感谢帮助,经测试完全复合要求,我稍作修改, a2:i  修改成 a2:bl (或者zz) 理由同 回复weiqigreen
示例附件表头1行表格列宽9列(i列)完全复合要求。把工作表列宽 i 设置成一般表格都不会超过的列宽,如BL(64列),这样汇总工作簿汇总任意工作表,只修根据工作表表头行数修改一个参数即可。通用性强,可做工具表使用。
再有今天的评分用完了,明天补上,再次感谢。

TA的精华主题

TA的得分主题

发表于 2017-8-12 17:33 | 显示全部楼层
LWXT 发表于 2017-8-12 14:48
非常感谢帮助,经测试完全复合要求,我稍作修改, a2:i  修改成 a2:bl (或者zz) 理由同 回复weiqigreen ...

根据自己的实际需求稍作修改即可。关键在于我们要学会举一反三。

评分

参与人数 1鲜花 +2 收起 理由
LWXT + 2 感谢帮助

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册 新浪微博登陆

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程

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

GMT+8, 2017-8-17 07:36 , Processed in 0.104447 second(s), 27 queries , Gzip On, MemCache On.

Powered by Discuz! X3.3

© 2001-2017 Wooffice Inc.

   

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

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

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