| 所在主题: | |
| 文件名: EXCEL电子问卷汇总.rar | |
| 资料下载链接地址: https://bbs.pinggu.org/a-491180.html | |
| 附件大小: | |
|
由于许多用户宏是默认禁用的,这样会降低邮件发出去的EXCEL电子表格问卷的回收率,所以EXCEL电子表格问卷设计最好不带宏。
这样可以从另外一个表格进行汇总收集回来的多份表格。 为了符合自己的要求,大家可以对下面的附件进行修改,其注意事项为: 数据汇总表格和要汇总的表格放在同一文件夹内; 问卷内的表格控件链接设置到隐藏的SHEET2内的第三行,A3要空出来。 附件包含四个表格: 数据汇总.xls(内含VBA,一键汇总下面三个表格数据) 回收问卷1.xls 回收问卷2.xls 回收问卷3.xls 其VBA程序为: Sub aa() Dim Fso, Fld, Fln, Wk Dim Wa As Workbook, W As Workbook Dim Sh As Worksheet Application.ScreenUpdating = False '关闭屏幕刷新 Application.DisplayAlerts = False '禁用所有事件 With ThisWorkbook.Sheets(1) Range(.Cells(3, 1), .Cells(65536, 100)).ClearContents End With Set Wa = ThisWorkbook Set Fso = CreateObject("Scripting.FilesystemObject") Set Fld = Fso.getfolder(ActiveWorkbook.Path & "\") Set Fln = Fld.Files i = Wa.Sheets(2).[B65536].End(xlUp).Row For Each Wk In Fln If Wk.Name <> Wa.Name Then Workbooks.Open Wk Set W = ActiveWorkbook W.Sheets(2).Rows(3).Copy Wa.Sheets(1).Cells(i, 1).PasteSpecial Paste:=xlPasteValues Wa.Sheets(1).Cells(i, 1) = W.Name W.Close i = i + 1 End If Next Application.DisplayAlerts = True ' 启用所有事件 Application.ScreenUpdating = True '打开屏幕刷新 End Sub |
|
熟悉论坛请点击新手指南
|
|
| 下载说明 | |
|
1、论坛支持迅雷和网际快车等p2p多线程软件下载,请在上面选择下载通道单击右健下载即可。 2、论坛会定期自动批量更新下载地址,所以请不要浪费时间盗链论坛资源,盗链地址会很快失效。 3、本站为非盈利性质的学术交流网站,鼓励和保护原创作品,拒绝未经版权人许可的上传行为。本站如接到版权人发出的合格侵权通知,将积极的采取必要措施;同时,本站也将在技术手段和能力范围内,履行版权保护的注意义务。 (如有侵权,欢迎举报) |
|
京ICP备16021002号-2 京B2-20170662号
京公网安备 11010802022788号
论坛法律顾问:王进律师
知识产权保护声明
免责及隐私声明