Excel高效實戰應用：VBA一鍵自動匯總多表問卷調查結果（含案例下載）

06-08

HI，夥伴們，你有用Excel做過問卷調查嗎？你是怎麼做的？

最近一個夥伴詢問，他們公司的廠區保安承包給一家物業公司，半年了，領導讓他在公司內部對這家物業公司的服務滿意度做一下問卷調查，問我有沒有什麼簡單快捷的辦法？

公司有1000多人，以前都是把問卷調查文件群發給同事，然後大家填寫完後再回發給他統計數據，收集回來的問卷調查數據也是亂七八糟的，所以他經常要花兩三天時間去匯總和計算數據。我一看，暈菜了，怎麼什麼答案都有呀，而且這些答案還是一個一個過濾後才能錄入。

下圖是最終自動匯總效果，他只需要點擊「匯總請點我」按鈕，稍等片刻，程序就全部統計好，再也不需要幾天幾夜，秒秒鐘就可以出結果！會這樣的技能，領導不喜歡才怪呢！

今天沈老師就跟大家分享問卷調查製作方法。

一、製作調查問卷模板

很多人製作調查問卷模板時瞻前不顧後，做表格的時候很爽，匯總數據時就不爽了。在製作問卷模板時，除了考慮要調查的問卷內容外，還要考慮數據怎麼統一規範，數據怎麼來匯總等一系列問題。

STEP1：首先製作一份問卷調查表。如下圖所示。

STEP2：為了統一規範答案，所以我們在右側設置下拉框選擇答案。我們使用數據驗證或者叫數據有效性（不同的Excel版本，叫法不一樣）。注意「A,B,C,D」中間的逗號是在英文半形狀態下輸入的。

STEP3：接下來我們來設計數據鏈接。為了後續數據匯總方便,我們把答案統一引用到第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代碼來支撐。