分享

Excel高效实战应用:VBA一键自动汇总多表问卷调查结果(含案例下载)

 Excel教程平台 2020-10-30

HI,伙伴们,你有用Excel做过问卷调查吗?你是怎么做的?

最近一个伙伴询问,他们公司的厂区保安承包给一家物业公司,半年了,领导让他在公司内部对这家物业公司的服务满意度做一下问卷调查,问我有没有什么简单快捷的办法?

公司有1000多人,以前都是把问卷调查文件群发给同事,然后大家填写完后再回发给他统计数据,收集回来的问卷调查数据也是乱七八糟的,所以他经常要花两三天时间去汇总和计算数据。我一看,晕菜了,怎么什么答案都有呀,而且这些答案还是一个一个过滤后才能录入。

下图是最终自动汇总效果,他只需要点击“汇总请点我”按钮,稍等片刻,程序就全部统计好,再也不需要几天几夜,秒秒钟就可以出结果!会这样的技能,领导不喜欢才怪呢!

今天沈老师就跟大家分享问卷调查制作方法。

一、制作调查问卷模板

很多人制作调查问卷模板时瞻前不顾后,做表格的时候很爽,汇总数据时就不爽了。在制作问卷模板时,除了考虑要调查的问卷内容外,还要考虑数据怎么统一规范,数据怎么来汇总等一系列问题。

STEP 1:首先制作一份问卷调查表。如下图所示。

STEP 2:为了统一规范答案,所以我们在右侧设置下拉框选择答案。我们使用数据验证或者叫数据有效性(不同的Excel版本,叫法不一样)。注意“A,B,C,D”中间的逗号是在英文半角状态下输入的。

STEP 3:接下来我们来设计数据链接。为了后续数据汇总方便,我们把答案统一引用到第21行。

STEP  4:设计好后保存,然后把调查问卷表格群发出去。

二、快速收集问卷调查数据

STEP 1:新建一个Excel文档,保存类型设置为保存为Excel启用宏的工作簿。

STEP 2:点击工作表名,选择查看代码。

STEP 3:插入模块,并在模块上输入具有汇总功能的代码。

详细代码如下:

Sub huizong()

   Dim bt As Range, r As Long, c As Long

    r= 1    '1 是表头的行数

    c= 8    '8 是表头的列数,也就是有几道题

   Range(Cells(r + 1, "A"), Cells(65536, c)).ClearContents    ' 清除汇总表中原表数据

   Application.ScreenUpdating = False

   Dim FileName As String, wb As Workbook, Erow As Long, fn As String, arrAs Variant

   FileName = Dir(ThisWorkbook.Path & "\*.xlsx")

   Do While FileName <> ""

       If FileName <> ThisWorkbook.Name Then    ' 判断文件是否是本工作簿

           Erow = Range("A1").CurrentRegion.Rows.Count + 1    ' 取得汇总表中第一条空行行号

            fn = ThisWorkbook.Path &"\" & FileName

           Set wb = GetObject(fn)    ' 将fn 代表的工作簿对象赋给变量

           Set sht = wb.Worksheets(1)    ' 汇总的是第1 张工作表

           ' 将数据表中的记录保存在arr 数组里

           arr = sht.Range("A21:H21")  ' 答案收集在第21行的A21:H21

           ' 将数组arr 中的数据写入工作表

           Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

           wb.Close False

       End If

       FileName = Dir    ' 用Dir 函数取得其他文件名,并赋给变量

   Loop

   Application.ScreenUpdating = True

End Sub

STEP 4:保存代码后退出,插入一个图形按钮,链接该宏程序,然后保存文件,并将该文件与汇总回来的调查问卷放在同一个文件夹下面,最终的效果如下:

小结:设计问卷需要用到Excel的一些常用技法,后面的一键汇总则需要VBA代码来支撑。

本文配套的教学案例在Excel学习QQ群:247329767下载。

    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多