用word统计调查问卷（非表格），如何方便统计汇总？（目前难点word带格式赋值）

465238836

    导师布置了一个作业，做一个调查，当时在做的时候没有经验，问卷用了word编写，然后到处发送，等收回来（电子版）的时候，才发现要崩溃了，既不是excel又不是表格，没办法汇总每一个问题项的答案总数，更谈不上后面的分析了，但是时间快到了，又不能重新再调查一遍，只好死马当活马医。但是4000多份的调查问卷，一个一个的手工录入估计。。。。。
    昨天彻夜未眠，曲线救国，想到一个思路，把每一个问卷的同一个问题所在的段落批量提取出来汇总到一个word文件，然后在这个文件中数答案，虽然也很麻烦很麻烦，但是比起打开每一个问卷要强得多了。百度后，得到以下批量提取固定段落的vba代码：
Sub 宏1()
hb = InputBox("请输入您要合并的文件所在的路径及文件夹名称。")
Set fso = CreateObject("Scripting.FileSystemObject")
Set fdr = fso.GetFolder(hb)
Set sf = fdr.Files
For Each f1 In sf
Documents.Open (f1)
ARange = ActiveDocument.Paragraphs(5)
BRange = BRange & ARange & Chr(13)
Documents(1).Close
Next
Set A_doc = Application.Documents.Add
A_doc.Range(0, 0) = BRange
End Sub

在实验中发现确实可以批量提取某文件夹下的所有文档的固定段落（此代码中是第五段）文字，并且汇总到新文件。
但是新的问题又出现了，汇总过来的是不带格式的。有些人填问卷的时候不是打勾，而是把答案颜色标红或者别的颜色，用以上代码批量提取后，所有的都是一个格式，级分辨不出来问卷所选的答案了。求指点。

465238836

上传问卷。
截图：

465238836

用一楼的代码运行后得到效果如下：
可以看出如果在问卷中凡是改变答案的都能看出来，但是只是改变答案颜色的话，就看不出效果了，自然无法统计了。

请指点。

465238836

另外大家有什么更好的方法进行统计吗？

465238836

很急呀，没人吗？

wudixin96

复制一条，添加一条就可以把格式搞过来

465238836

wudixin96 发表于 2014-3-11 17:29
复制一条，添加一条就可以把格式搞过来

你好，能不能给段代码参考下。

jsxjd

465238836 发表于 2014-3-11 16:22
用一楼的代码运行后得到效果如下：
可以看出如果在问卷中凡是改变答案的都能看出来，但是只是改变答案颜色 ...

用颜色进行选择的？比较糟糕

wudixin96

1. sPath="路径"
   
2. With ThisDocument
   
3.   Set wd = Documents.Open(sPath & "\在线购物体验调查问卷 (1).doc")
   
4.    wd.Paragraphs(5).Range.Copy
   
5.     .Range(.Range.End - 1).Paste
   
6.     wd.Close False
   
7.   Set wd = Nothing
   
8. End With

复制代码

效果如图。

465238836

jsxjd 发表于 2014-3-11 17:44
用颜色进行选择的？比较糟糕

所以很头疼啊。早知道最后有这么多问卷就建议导师用现成的问卷系统了。再不济用excel也行，这下整成word，还是纯文本的，真不知道该怎么办才好了。对于直接打勾或者什么的问卷还是好，改颜色的就太可恶了，根本没法统计嘛。大神想想办法呗。
T^T