调查问卷汇总报告模板,调查问卷模板及范文

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代码来支撑。

End.

运行人员：中国统计网小编（*itongjilove）

微博ID：中国统计网

中国统计网，是国内最早的大数据学习网站，公众号：中国统计网

http://www.itongji.cn