需要Excel宏的帮助来组织混乱的调查

Question

我一直在尝试编写一个宏（步骤）来组织设计非常糟糕的调查结果，但我运气不佳。

以下是我的例子：

以下是我需要的样本：

我遇到了几个问题，其中一个问题是，调查中的所有15个问题都不是必须回答的，这使得以平稳的方式顺利完成结果。

一个更大的问题（与之前的问题相关）是调查中的15个问题中有3个是“选择所有应用”类型的问题，并且每个选项都被记录为单独的答案，但具有相同的数字。例如，问题10有11种可能的选择，用户可以根据需要选择尽可能多的选择。如果他们选择问题10的第1和第3个选项，结果将类似于What I have样本的第3行和第4行。

我的What I need示例显示我需要列中的所有问题以及所有响应者编号在他们自己的行中，并且答复者在他们各自的编号下的答案很长。

最终产品中不需要ID示例中的What I have列，但我现在将其留在结果中，以为它可能会以某种方式帮助排除这个混乱。

我想知道我是否应该回到那个给我的人那里并告诉他们我很抱歉但我不能做任何事情，因为它太乱了。如果您认为可以修复这些调查结果，请给我一些指示（详细说明，我对VB脚本没有太多经验）。

欢迎任何其他意见，想法或建议。

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
<...>