一键汇总多份EXCEL电子表格问卷 [推广有奖]

0关注
0粉丝

已卖：184份资源

大专生

63%

还不是VIP/贵宾

威望: 0 级
论坛币: 359 个
通用积分: 5.6625
学术水平: 1 点
热心指数: 0 点
信用等级: 0 点
经验: 1386 点
帖子: 12
精华: 0
在线时间: 99 小时
注册时间: 2009-12-2
最后登录: 2016-11-23

楼主

dudebad 发表于 2009-12-14 18:55:22 |AI写论文

是否 +2 论坛币

k人参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

由于许多用户宏是默认禁用的，这样会降低邮件发出去的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