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

Question

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

这是我所拥有的示例：

这是我需要的示例：

我遇到了几个问题，其中之一是调查中的 15 个问题并非全部都需要回答，这使得循环遍历结果时尚难顺利。

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

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

最终产品中不需要 What I have 示例中的 ID 列，但我暂时将其保留在结果中，认为它可能会以某种方式帮助解决这个混乱问题。

我想知道我是否应该回到给我这个的人并告诉他们我很抱歉，但我对此无能为力，因为它太混乱了。如果您认为可以修复这些调查结果，请给我一些指示（请详细说明，我对 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
<...>