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

Question

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

这是我所拥有的示例：

这是我需要的样本：

我遇到了几个问题，其中一个是调查中的 15 个问题并非全部都必须回答，这使得以流畅的方式循环遍历结果很困难。

更大的问题（与上一期相关）是调查中的 15 个问题中有 3 个是“选择所有适用”类型的问题，并且每个选择都被记录为单独的答案，但编号相同。例如，问题 10 有 11 个可能的选项，用户可以根据需要选择任意多或少的选项。如果他们选择了问题 10 的第 1 和第 3 个选项，结果将类似于我的 What I have 示例的第 3 行和第 4 行。

我的What I need 示例显示我需要列中的所有问题和各自行中的所有受访者编号，以及受访者在其各自编号下的长答案。

最终产品中不需要来自What I have 示例的ID 列，但我暂时将其留在结果中，认为它可能有助于解决这个问题。

我想知道我是否应该回到给我这个的人那里并告诉他们我很抱歉，但我对此无能为力，因为它太混乱了。如果您认为可以修复这些调查结果，请给我一些指点（详细一点，我对 VB Script 没有太多经验）。

也欢迎任何其他的 cmets、想法或建议。

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