在Excel宏方面需要幫助以組織混亂的調查

Question

我一直在嘗試（逐步）編寫一個宏來組織一個設計很差的調查的結果，但是我運氣很少。

這是我所擁有的樣本：

這是我需要的樣本：

我遇到了幾個問題，其中之一是，並非必須回答調查中的所有15個問題，這使得很難順利地遍歷結果。

更大的問題（與上一個問題並列）是，調查中的15個問題中有3個是“全選適用”類型的問題，每個選擇都被記錄為單獨的答案，但是編號相同。 例如，問題10有11種可能的選擇，用戶可以根據需要選擇任意數量的選擇。 如果他們選擇了問題10的第1個和第3個選項，結果將類似於What I have樣本”的第3行和第4行。

我的What I need樣本顯示，我需要列中的所有問題以及他們自己的行中的所有受訪者編號，並在各自的編號下包含受訪者的長答案。

最終產品不需要What I have樣品”中的ID列，但我將其留在結果中，現在認為它可能以某種方式有助於解決此問題。

我想知道我是否應該再找給我這個東西的人，告訴他們我很抱歉，但是我不能做任何事情，因為它太混亂了。 如果您認為有可能修復這些調查結果，請給我一些指導（詳細說明，我對VB Script經驗不足）。

也歡迎任何其他評論，想法或建議。

Answer 1

我有多年在Excel和Access 2003和2010中使用VBA的經驗，我可以告訴您在Excel中處理它並不是一件很有趣的事情。 根據調查結果的結構，我強烈建議將其導入Access（如果有）並運行SQL查詢以對數據進行切片和切塊。 它實際上是數據庫表的格式，甚至具有主鍵（ID）。

Answer 2

我會將其導入數據庫，然后使用一個或兩個簡單查詢生成所需的內容。

Answer 3

這是Excel VBA中的一個開始，在Access中，這是一個非常簡單的查詢。

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


cn.Open strCon

''Note that strings are case-sensitive
strSQL = "Transform First(a.Answer) As Ans " _
       & "SELECT a.Respondent " _
       & "FROM [Sheet2$] As b " _
       & "LEFT JOIN " _
       & "(SELECT ID,Val(Question & '.' & " _
       & "IIf(Mid(Answer,5,8)='Checkbox', Mid(Answer,1,1),1)) As Qstn, " _
       & "Respondent,Answer " _
       & "FROM [Sheet1$]) As a " _
       & "ON a.[Qstn]=b.[Question] " _
       & "GROUP BY a.Respondent " _
       & "PIVOT b.question"


rs.Open strSQL, cn, 3, 3

''Pick a suitable empty worksheet for the results
For i = 0 To rs.fields.Count - 1
    Worksheets("Sheet3").Cells(1, i + 1) = rs.fields(i).Name
Next

Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

這是基於在sheet2上有一個表格，如下所示：

Question
1.1
2.1
3.1
4.1
5.1
6.1
7.1
8.1
9.1
9.2
9.3
9.4
10.1
10.2
10.3
10.4
11.1
11.1
11.1
11.1
11.1
<...>