[字典嵌套][三维数组]对结构基本相同、同名工作表列项目不同的多个工作簿按表名汇总

zxhmfk

好贴，顶一下下

先行者

赵老师，您好：为何小弟下载您的附件运行后出现的是内存溢出这种情况，能否请您在看一下（截屏如下），谢谢！

zhaogang1960

原帖由 先行者 于 2010-11-29 08:51 发表
赵老师，您好：为何小弟下载您的附件运行后出现的是内存溢出这种情况，能否请您在看一下（截屏如下），谢谢！

从代码上看可能需要较大内存，此帖没有实际使用价值，不必研究它了

lzchenxm

我也十分感谢赵老师，在2009-3-18 23:38  我在论坛里求助，(已解决)VBA财金综合编程实例机会,亲生体验非现场预警内涵,求助高手编数据分发程序，http://club.excelhome.net/thread-410217-1-1.html是赵老师热心帮我解决的，最近我因要提取文件夹里多表固定单元格数据统计在一张表中汇总，也得到了圆满解决，这论坛有赵老师这样的高手，是我们这些初学和使用者的福气，诚祝赵老师全家一生安康幸福。

根据《EXCEL之家赵老师》提取数据VBA代码改写：

     （按固定格式方式提取代码）

Private Function GetValue(path As String, file As String, sheet As String, ref As String)  ’ 从未打开的Excel文件中检索数据

    Dim arg As String ’确保该文件存在

    If Right(path, 1) <> "\" Then path = path & "\"
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)’'   执行XLM 宏

    GetValue = ExecuteExcel4Macro(arg)
End Function   


Sub 汇总()
    Dim p As String, f As String, s As String, a As String
    Dim arr, brr, myFile As String, n As Integer
    arr = Array("销售时间", "客户姓名", "性别", "年龄", "住址", "联系电话", "诊断", "诊费", "实付药费", "中药付数", "合计费用")
    brr = Array("B6", "B2", "C2", "E2", "B4", "B3", "B5", "E29", "E34", "E31")
    Columns("A:K").ClearContents
    Range("a1:k1").Value = arr
    myFile = Dir(ThisWorkbook.path & "\*.xls")
    n = 1
    Do While myFile <> ""
        If myFile <> ThisWorkbook.Name Then
            n = n + 1
            p = ThisWorkbook.path
            f = myFile
            s = "Sheet1"
            For i = 1 To 10
                a = brr(i - 1)
                Cells(n, i) = GetValue(p, f, s, a)
            Next i
        End If
        myFile = Dir
    Loop
End Sub

excelflower

多谢老师！这个很实用，下来学习学习。

jjmysjg

zhaogang1960版主好！
荣幸找到这样的好帖子。
如果我的数据中的“客户名称”是在“B5”单元格，修改哪个代码？

7786910

谢谢了，下来学习！

cqr123

赵老师是个高手啊

yjangel80

一定要学习学习 果然是大师阿

lvenqi

太厉害了。谢谢，我收下了。