VBA小白求大神相助！！Excel问卷如何汇总到一张表格中？？

fa_sy9

需要将122份问卷的数据按照附件中的汇总模板汇总，已有代码，只能汇总部分数据，不知道什么原因，求大神指点，感激不尽！


Sub 宁夏农行()  '
Dim sht As Worksheet    ' 2010/2/5 改采用 offset的概念，如此可以减少因为栏位的位置变化而需大幅度更改程序内容
Dim Col_idx             ' 只要将array变数因顺序写好并于其下一行记得将col_idx+1(移往下一个栏位)
Dim arr(1 To 250)       '预留250个变数，变数增加再改数字
On Error Resume Next
p = ThisWorkbook.Path & "\"
f = p & "\*.xls"
fs = Dir(f)
Sheets("Data").Rows("3:5025").ClearContents
Col_idx = 1   '代表是栏位A

For vari = 1 To UBound(arr)
arr(vari) = Range(Cells(7, Col_idx), Cells(3000, Col_idx))
Col_idx = Col_idx + 1
Next vari




'----照贴上Data的顺序填放问卷的位置
Application.ScreenUpdating = False
ActiveWindow.DisplayZeros = False
bookCount = 1
Do While fs <> ""
   If fs <> ThisWorkbook.Name Then
        Workbooks.Open p & fs
        Set sht = ActiveWorkbook.Sheets("营业网点神秘人检查标准（2015版）")
        'sheet1
arr(1)(bookCount,1) = fs
arr(2)(bookCount,1)=sht.Range("E2")
arr(3)(bookCount,1)=sht.Range("H2")
arr(5)(bookCount,1)=sht.Range("E3")
arr(6)(bookCount,1)=sht.Range("H3")
arr(7)(bookCount,1)=sht.Range("E4")
arr(8)(bookCount,1)=sht.Range("H4")
arr(9)(bookCount,1)=sht.Range("E5")
arr(10)(bookCount,1)=sht.Range("H5")
arr(13)(bookCount,1)=sht.Range("J9")
arr(14)(bookCount,1)=sht.Range("J10")
arr(15)(bookCount,1)=sht.Range("J11")
arr(16)(bookCount,1)=sht.Range("J12")
arr(17)(bookCount,1)=sht.Range("J13")
arr(18)(bookCount,1)=sht.Range("J14")
arr(19)(bookCount,1)=sht.Range("J15")
arr(20)(bookCount,1)=sht.Range("J16")
arr(21)(bookCount,1)=sht.Range("J17")
arr(22)(bookCount,1)=sht.Range("J18")
arr(23)(bookCount,1)=sht.Range("J19")
arr(24)(bookCount,1)=sht.Range("J20")
arr(25)(bookCount,1)=sht.Range("J21")
arr(26)(bookCount,1)=sht.Range("J22")
arr(27)(bookCount,1)=sht.Range("J23")
arr(28)(bookCount,1)=sht.Range("J24")
arr(29)(bookCount,1)=sht.Range("J25")
arr(30)(bookCount,1)=sht.Range("J26")
arr(31)(bookCount,1)=sht.Range("J27")
arr(32)(bookCount,1)=sht.Range("J28")
arr(33)(bookCount,1)=sht.Range("J29")
arr(34)(bookCount,1)=sht.Range("J30")
arr(35)(bookCount,1)=sht.Range("J31")
arr(36)(bookCount,1)=sht.Range("J33")
arr(37)(bookCount,1)=sht.Range("J34")
arr(38)(bookCount,1)=sht.Range("J35")
arr(39)(bookCount,1)=sht.Range("J36")
arr(40)(bookCount,1)=sht.Range("J37")
arr(41)(bookCount,1)=sht.Range("J38")
arr(42)(bookCount,1)=sht.Range("J39")
arr(43)(bookCount,1)=sht.Range("J40")
arr(44)(bookCount,1)=sht.Range("J41")
arr(45)(bookCount,1)=sht.Range("J42")
arr(46)(bookCount,1)=sht.Range("J43")
arr(47)(bookCount,1)=sht.Range("J44")
arr(48)(bookCount,1)=sht.Range("J45")
arr(49)(bookCount,1)=sht.Range("J46")
arr(50)(bookCount,1)=sht.Range("J47")
arr(51)(bookCount,1)=sht.Range("J48")
arr(52)(bookCount,1)=sht.Range("J49")
arr(53)(bookCount,1)=sht.Range("J50")
arr(54)(bookCount,1)=sht.Range("J51")
arr(55)(bookCount,1)=sht.Range("J52")
arr(56)(bookCount,1)=sht.Range("J54")
arr(57)(bookCount,1)=sht.Range("J55")
arr(58)(bookCount,1)=sht.Range("J56")
arr(59)(bookCount,1)=sht.Range("J57")
arr(60)(bookCount,1)=sht.Range("J59")
arr(61)(bookCount,1)=sht.Range("J60")
arr(62)(bookCount,1)=sht.Range("J61")
arr(63)(bookCount,1)=sht.Range("J62")
arr(64)(bookCount,1)=sht.Range("J63")
arr(65)(bookCount,1)=sht.Range("J64")
arr(66)(bookCount,1)=sht.Range("J65")
arr(67)(bookCount,1)=sht.Range("J66")
arr(68)(bookCount,1)=sht.Range("J67")
arr(69)(bookCount,1)=sht.Range("J68")
arr(70)(bookCount,1)=sht.Range("J69")
arr(71)(bookCount,1)=sht.Range("J70")
arr(72)(bookCount,1)=sht.Range("J71")
arr(73)(bookCount,1)=sht.Range("J72")
arr(74)(bookCount,1)=sht.Range("J73")
arr(75)(bookCount,1)=sht.Range("J74")
arr(76)(bookCount,1)=sht.Range("J75")
arr(77)(bookCount,1)=sht.Range("J76")
arr(78)(bookCount,1)=sht.Range("J77")
arr(79)(bookCount,1)=sht.Range("J78")
arr(80)(bookCount,1)=sht.Range("J79")
arr(81)(bookCount,1)=sht.Range("J80")
arr(82)(bookCount,1)=sht.Range("J81")
arr(83)(bookCount,1)=sht.Range("J82")
arr(84)(bookCount,1)=sht.Range("J83")
arr(85)(bookCount,1)=sht.Range("J84")
arr(86)(bookCount,1)=sht.Range("J85")
arr(87)(bookCount,1)=sht.Range("J86")
arr(88)(bookCount,1)=sht.Range("J87")
arr(89)(bookCount,1)=sht.Range("J88")
arr(90)(bookCount,1)=sht.Range("J89")
arr(91)(bookCount,1)=sht.Range("J90")
arr(92)(bookCount,1)=sht.Range("J91")
arr(93)(bookCount,1)=sht.Range("J92")
arr(94)(bookCount,1)=sht.Range("J93")
arr(95)(bookCount,1)=sht.Range("J94")
arr(96)(bookCount,1)=sht.Range("J95")
arr(97)(bookCount,1)=sht.Range("J96")
arr(98)(bookCount,1)=sht.Range("J97")
arr(99)(bookCount,1)=sht.Range("J98")
arr(100)(bookCount,1)=sht.Range("J99")
arr(101)(bookCount,1)=sht.Range("J100")
arr(102)(bookCount,1)=sht.Range("J103")
arr(103)(bookCount,1)=sht.Range("J104")
arr(104)(bookCount,1)=sht.Range("J106")
arr(105)(bookCount,1)=sht.Range("J108")
arr(106)(bookCount,1)=sht.Range("J109")
arr(107)(bookCount,1)=sht.Range("J110")
arr(108)(bookCount,1)=sht.Range("J111")
arr(109)(bookCount,1)=sht.Range("J112")
arr(110)(bookCount,1)=sht.Range("J113")
arr(111)(bookCount,1)=sht.Range("J114")
arr(112)(bookCount,1)=sht.Range("J115")
arr(113)(bookCount,1)=sht.Range("J116")
arr(114)(bookCount,1)=sht.Range("J117")
        Set sht = Nothing
        Workbooks(fs).Close False
        bookCount = bookCount + 1
   End If
   fs = Dir
Loop
Application.ScreenUpdating = True
bookCount = bookCount - 1
Col_idx = 1  '代表是栏位A

For vari = 1 To UBound(arr)
Range(Cells(7, Col_idx), Cells(3000, Col_idx)) = arr(vari)
Col_idx = Col_idx + 1
Next vari
ActiveWindow.DisplayZeros = True
MsgBox "共调出了 " & bookCount & " 个问卷中的数据!!", vbInformation, ThisWorkbook.Name
End Sub

fa_sy9

嘿嘿，问题已经自己解决了！

lys4464

怎么解决大啊，奉献一下啊

gmts

对吖，好东西分享一下吧