温馨提示:本文最后更新于
2024-12-17 21:15:50
,某些文章具有时效性,若有错误或已失效,请在下方留言。Sub Summary_Click()
'定义合并文件夹目录;
Dim path As String
'标题头只运行一次
Dim once As Integer
once = 1
'定义合并总表的文件名
Dim activeName As String
'定义当前文件夹当前检查获取的文件名
Dim xlsxName As String
'定义wb存储获取的工作簿
Dim Wb As Workbook
'关闭屏幕更新,优化合并效率
Application.ScreenUpdating = False
'获取当前合并总表的目录, 'E:\多表本合并'
path = ActiveWorkbook.path
'获取当前合并后总表的文件名
activeName = ActiveWorkbook.Name
'获取path路径下的所有'.xlsx'文件名,'E:\多表本合并\*.xlsx'
xlsxName = Dir(path & "\" & "*.xlsx")
'当前文件夹内的xlsx文件未遍历完
Do While xlsxName <> ""
'并且当前访问的不是总表
If xlsxName <> activeName Then
'依次打开每一个xlsx文件
Set Wb = Workbooks.Open(path & "\" & xlsxName)
'使用了With,也可以不使用,将三行合成一行代码
'Wb.Sheets(1).Range("2:2").Copy ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Range("B65536").End(xlUp).Row + 1, 1)
With ThisWorkbook.Worksheets(1)
'将打开的表格的第二列(除去表头),赋值到总表当前总表已有数据的下一行
'Wb.Sheets(1).Range("2:2").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
If once = 1 Then
ThisWorkbook.Worksheets(1).Range("A1:U1") = Array("序号", "方案编号", "case 编号", "研究中心编号", "受试者编号", "发生国家", "安全性事件的首选术语", "申办方获知时间", "报告类型(初始/随访)", "SAE 标准", "事件发生日期", "事件结束日期", "对试验药物采取的措施", "预期/非预期", "事件转归", "相关性判断-研究者判断", "相关性判断-公司判断", "性别", "出生年份", "本报告生成时间", "7/15 天报告")
once = 2
End If
' 从A3单元格开始
Wb.Sheets(1).Range("A4", Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
End With
'关闭当前遍历的工作簿,不保存
Wb.Close False
End If
'调用Dir函数,找到当前目录的下一个xlsx文件
xlsxName = Dir
Loop
'恢复幕更新
Application.ScreenUpdating = True
End Sub
© 版权声明
THE END
暂无评论内容