合并代码求修改

lzqlaj

LWXT 发表于 2017-8-12 14:37
非常感谢您的帮助，经测试完全复合要求，但我认为： brr = AK.Sheets(1).Range("A4:E" & aRow) 中的A4：E ...

用ls = Range("IV3").End(xlToLeft).Column得到第三行数据列数，不必赋值64列。

lzqlaj

表头可以这样解决
aa = Application.InputBox(prompt:="请输入分表表头行数（默认：3)", Title:="分表表头行数", Default:="3", Type:=1)

lzqlaj

试试下面的代码。

lzqlaj

其实除了数组外，还可以把下面这句换成后面三句。实际就是 选择粘贴-数值。
  'AK.Sheets(1).Range("A4:BL" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)   'A3指开始合并   单元格位置，可据实修改，BL指列的宽度（64列），日常基本够用不用修改。
   AK.Sheets(1).Range("A4:BL" & aRow).Copy
   ThisWorkbook.Sheets(1).Range("a" & tRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

LWXT

lzqlaj 发表于 2017-8-12 18:59
试试下面的代码。

非常感谢您的帮助，现在没空，抽空试试，感觉应该比原来方便些。谢谢。

LWXT

lzqlaj 发表于 2017-8-12 18:59
试试下面的代码。

您好，我把代码抄写了一下（因图片格式无法复制）放入工作表中，点击汇总按钮，不能运行。不知是我抄写代码有误，还是操作不当，我是新手，麻烦您帮忙看下，问题出在了哪里。见截屏图及附件，谢谢

lzqlaj

LWXT 发表于 2017-8-13 17:39
您好，我把代码抄写了一下（因图片格式无法复制）放入工作表中，点击汇总按钮，不能运行。不知是我抄写代 ...

第一行trows%后面的，“，”，小写,不是逗号。

lzqlaj

Sub hz()
   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer, arr(), aa, ls
   aa = Application.InputBox(prompt:="请输入分表表头行数（默认：3)", Title:="分表表头行数", Default:="3", Type:=1)
   If aa = False Or aa <= 0 Then Exit Sub
   ls = Range("IV" & aa).End(xlToLeft).Column
   Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   myPath = ThisWorkbook.Path & "\"          '把文件路径定义给变量  当前文件夹（ 原代码【& "\统计表\" 】）
      myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.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(.Cells(aa + 1, 1), .Cells(aRow, ls)).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

LWXT

lzqlaj 发表于 2017-8-13 20:49
第一行trows%后面的，“，”，小写,不是逗号。

  果然是高手，修改后代码能够运行了。点击绿色三角运行按钮，即显示分表表头行数对话框，按实际填写表头行数确定，即可运行。自动显示“分表表头行数”对话框，任意表格汇总再也不用再代码中修改参数了，非常实用方便。
      我是初学，习惯做成汇总按钮，点击按钮来运行宏，可我直接点击汇总按钮代码不能显示“分表表头行数”对话框，所以不能直接点击按钮运行。
       不知怎样指定宏操作才能直接点击汇总按钮，就能直接出现“分表表头行数”对话框。请您指教。
今天的评分已用完，明天补上。谢谢

lzqlaj

LWXT 发表于 2017-8-13 22:09
果然是高手，修改后代码能够运行了。点击绿色三角运行按钮，即显示分表表头行数对话框，按实际填写表头 ...

见附件。。。