请老师优化一下代码

wcj6376tcp

Sub 合并目录下所有工作簿()
    Dim MyPath, MyName, AWbName
    Dim Wb As Workbook, WbN As String
    Dim G As Long
    Dim Num As Long
    Dim BOX As String
    Application.ScreenUpdating = False
    wjj = InputBox("请输入文件夹名称", "默认文件夹", "拆分文件")   '需汇总的文件夹
    If wjj = "" Then Exit Sub
    MyPath = ThisWorkbook.Path & "\" & wjj
    If Len(Dir(MyPath, vbDirectory)) = 0 Then MkDir MyPath   'vbDirectory文件夹   MkDir创建目录或文件夹
    MyName = Dir(MyPath & "\" & "*.xls*")
    AWbName = ActiveWorkbook.Name
        With Sheets("汇总表")
        MaxRow = .UsedRange.Rows.Count
        If MaxRow > 3 Then
            .Range("A4:E" & MaxRow).ClearContents '删除原表头下数据
        End If
        End With
    Num = 0
    Do While MyName <> ""
        If MyName <> AWbName Then
            Set Wb = Workbooks.Open(MyPath & "\" & MyName)
            Num = Num + 1
            With Workbooks(1).ActiveSheet
                'For G = 1 To Sheets.Count
                MaxRow1 = .UsedRange.Rows.Count
                    ActiveSheet.Range("A4:E" & MaxRow1).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
                'Next
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
            End With
        End If
        MyName = Dir
    Loop
    MaxRow2 = Sheets("汇总表").Range("A3").End(xlDown).Row '行数
    Sheets("汇总表").Activate
    Cells(MaxRow2 + 1, 1).Value = "合计"
    Cells(MaxRow2 + 1, 2).Value = Application.WorksheetFunction.Sum(Range(Cells(4, 2), Cells(MaxRow2 + 1, 2)))
    Range("B1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & Num & "个工作薄如下：" & Chr(13) & WbN, vbInformation, "提示"
     ' 添加边框()
   Range(Cells(3, 1), Cells(MaxRow2 + 1, 5)).Select
    With Selection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

自己写的太死了，麻烦老师看看如果标题行数和列数都有变化，如何优化代码，可以通用，谢谢！

沈默00

上附件吧，说明一下需求....

taller

数据列数：

1. ActiveSheet.UsedRange.Columns.Count

复制代码

表头：需要有识别逻辑（例如填充色，标题行某个字段标题），否则代码无法确定行数

wcj6376tcp

沈默00 发表于 2024-3-9 09:42
上附件吧，说明一下需求....

收集到的表册格式都一样，但每次发出去的表册可能会存在标题行数和列数不确定，看看能不能通用，现在这个只能汇总标题行3行，数据列5列的

wcj6376tcp

ActiveSheet.Range("A4:E" & MaxRow1).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) 和 Cells(MaxRow2 + 1, 2).Value = Application.WorksheetFunction.Sum(Range(Cells(4, 2), Cells(MaxRow2 + 1, 2)))     Range(Cells(3, 1), Cells(MaxRow2 + 1, 5)).Select  如何动态变量获取，汇总表只保留一个标题行

Enocheasty

说句实话，规则只有楼主自己清楚，或者说，会遇到什么样的表，只有你自己清楚，想做一个通用的。那得程序有智能才行。除非你罗出处所有特性！其实就算是通用，也是对于你的需求的通用。
我倒是觉得VBA的特点就是解决专用的事情。

excel玉米

适用于自定义表头行数数量统一的情形。

wcj6376tcp

excel玉米 发表于 2024-3-9 13:33
适用于自定义表头行数数量统一的情形。

麻烦老师发一下代码呢？

wcj6376tcp

Enocheasty 发表于 2024-3-9 12:12
说句实话，规则只有楼主自己清楚，或者说，会遇到什么样的表，只有你自己清楚，想做一个通用的。那得程序有 ...

这种情况很多噻，你发一个模版出去大家填好各自的额数据回收，然后你肯定要汇总，不想一个个的去复制黏贴，同种格式的放一个文件夹，vba一键就汇总回来，这种情况应该很多吧/，标题行不一定确定，但格式肯定是一样的

ykcbf1100

没有附件，要改成通用，不太现实。首先：标题行有变化，其次，数据列有变化，第三，数据复制到目标表的位置也有变化。这些都要事先知道才行。第1个和第3个问题，需要合并前动态输入才行。第2个问题容易解决。