数据合并错误“1004”

zjgldy · 发表于 2019-5-10 12:08

本帖最后由 zjgldy 于 2019-5-11 12:46 编辑

恳请老师帮助，不限格式数据合并文件夹中的“数据合并”工作簿，运行出现“1004错误，无法对合并单元格执行此操作”，要如何修改才能正常运行。

zjdh · 发表于 2019-5-10 12:08

本帖最后由 zjdh 于 2019-5-11 08:50 编辑

稍作改动，将合并单元格语句插在宏中，马上见效！
Sub 数据合并()
Application.ScreenUpdating = False '关闭屏幕刷新，避免闪烁影响速度
Rows("2:1048576").ClearContents
With ThisWorkbook.Sheets("数据源")
      Set fso = CreateObject("scripting.filesystemobject")
      Set ff = fso.getfolder(ThisWorkbook.Path)
      For Each f In ff.Files
         If Not f.Name Like "*" & ThisWorkbook.Name Then
            Workbooks.Open f
            For Each s In ActiveWorkbook.Sheets
                  TR = .UsedRange.Rows.Count + 1
                  s.Select
                  .Range("a" & TR) = f.Name '工作簿名称
                  .Range("b" & TR) = s.Name '工作表名称
                  ActiveSheet.UsedRange.Offset(1).Copy .Range("c" & TR)
                  TR2 = .UsedRange.Rows.Count
                  .Range("A" & TR & ":A" & TR2).Merge
                  .Range("B" & TR & ":B" & TR2).Merge
            Next s
            ActiveWorkbook.Close False
         End If
      Next
      For Each sf In ff.subfolders
         For Each f In sf.Files
            Workbooks.Open f
            For Each s In ActiveWorkbook.Sheets
                  TR = .UsedRange.Rows.Count + 1
                  s.Select
                  .Range("a" & TR) = f.Name '工作簿名称
                  .Range("b" & TR) = s.Name '工作表名称
                  ActiveSheet.UsedRange.Offset(1).Copy .Range("c" & TR)
                  ‘’同上
            Next s
            ActiveWorkbook.Close False
         Next
      Next sf
      Application.ScreenUpdating = True '恢复屏幕刷新，避免闪烁影响速度
End With
End Sub

zjdh · 发表于 2019-5-10 18:17

把 tr = .[c1048576].End(xlUp).Row + 1
改成 tr = .UsedRange.Rows.Count + 1

zjgldy · 发表于 2019-5-10 18:33

zjdh 发表于 2019-5-10 18:17
把 tr = .[c1048576].End(xlUp).Row + 1
改成 tr = .UsedRange.Rows.Count + 1

zjdh

您好，改成 tr = .UsedRange.Rows.Count + 1后运行代码EXCEL重启（死机），烦请您帮测试下，菜鸟我感激涕零！

zjdh · 发表于 2019-5-11 08:31

zjgldy 发表于 2019-5-10 18:33
zjdh您好，改成 tr = .UsedRange.Rows.Count + 1后运行代码EXCEL重启（死机），烦请您帮测试下，菜鸟我 ...

不是死机，而是你的合并单元格的宏效率太低啦！
等上半个小时大概结果就出来了！

zjgldy · 发表于 2019-5-11 08:46

本帖最后由 zjgldy 于 2019-5-11 08:47 编辑

zjdh 发表于 2019-5-11 08:31
不是死机，而是你的合并单元格的宏效率太低啦！
等上半个小时大概结果就出来了！

zjdh

您好，等半个小时，我实际要合并的有300多个工作簿，这样需要多久啊！能否帮我改进下代码?

zjgldy · 发表于 2019-5-11 12:40

zjdh 发表于 2019-5-10 12:08
稍作改动，将合并单元格语句插在宏中，马上见效！
Sub 数据合并()
Application.ScreenUpdating = Fal ...

zjdh

您好，问题解决了，就是还有点小问题，请您再看看能否完善点。最好不要删除右侧的数据，还有标题栏下不要出现空行，呈上附件供您测试。

多簿多表数据合并.rar (73.47 KB, 下载次数: 12)

zjdh · 发表于 2019-5-11 18:38

你这次的数据形式又不同啦！并且数据表中有不少不可见数据，而不可见数据可能在行尾，又只能恢复原来的取尾行办法啦。
若数据列数较多可以修改这两句
.Columns("A:M").UnMerge '取消合并单元格
.Columns("A:M").ClearContents '为了不消除右侧数据，纵向消除数据
详见附件

多簿多表数据合并.rar (68.09 KB, 下载次数: 17)

zjgldy · 发表于 2019-5-11 20:39

zjdh 发表于 2019-5-11 18:38
你这次的数据形式又不同啦！并且数据表中有不少不可见数据，而不可见数据可能在行尾，又只能恢复原来的取尾 ...

zjdh

您好，非常感谢您耐心帮助，求助完美实现。

		自动登录	找回密码
密码			注册

数据合并错误“1004”

最佳答案