[已解决]多工作薄数据汇总

安全网

安全网 发表于 2016-1-22 08:50
不好意思！还有个问题要咨询下，图片横向和竖向的这个数值是通过那个代码导入到工作薄内的。还有我想把折 ...

图片已上传，还有有多个工作薄数据需要导入需修改那个参数

安全网

grf1973 发表于 2016-1-21 15:59
Sub 导入文件()
    Application.ScreenUpdating = False
    Dim Filename, wb As Workbook, Sht As Wor ...

请问老师：这样的不知道是否能直接找到最后一级的EXC工作表，引用工作表的数据，每个工作表的名称都不一样

安全网

grf1973 发表于 2016-1-21 15:59
Sub 导入文件()
    Application.ScreenUpdating = False
    Dim Filename, wb As Workbook, Sht As Wor ...

还有能否将最后一个文件夹的名称写入单元格，如：01月，02月，03月等等，写在日期的前面

安全网

grf1973 发表于 2016-1-21 15:59
Sub 导入文件()
    Application.ScreenUpdating = False
    Dim Filename, wb As Workbook, Sht As Wor ...

老师在吗？我这个是否能实现？

grf1973

上附件，模拟效果。

安全网

grf1973 发表于 2016-1-25 11:14
上附件，模拟效果。

附件已经上传，还有能否告知导入对象工作表的关键语句。谢谢！

grf1973

1. Dim w(1 To 10000), s%
   
2. Sub 导入文件()
   
3.     Application.ScreenUpdating = False
   
4.     Dim Filename, wb As Workbook, Sht As Worksheet, xRng As Range
   
5.     Filename = Dir(ThisWorkbook.Path & "\*.xls")
   
6.     arr = [a2:n2]
   
7.     ReDim brr(1 To 100, 1 To UBound(arr, 2))
   
8.     r = [a65536].End(3).Row + 1      '需要导入数据的起始行
   
9.     nn = Val(Cells(r - 1, 1))     '已有数据的序号
   
10.     On Error Resume Next
    
11.     s = 0
    
12.     zdir ThisWorkbook.Path & ""        '递归获得本文件夹及所有子文件夹内文件名，放入数组w
    
13.     Application.ScreenUpdating = False
    
14.     For i = 1 To s
    
15.         fn = w(i)            '要打开的文件名
    
16.         If InStr(fn, ThisWorkbook.Name) = 0 Then     '如果和本文件名不同，那么打开文件，开始导入
    
17.             Set wb = Workbooks.Open(fn)
    
18.             Set Sht = wb.Worksheets(1)
    
19.             n = n + 1
    
20.             brr(n, 1) = nn + n: brr(n, 2) = Split(fn, "")(UBound(Split(fn, "")) - 1): brr(n, 3) = Sht.[c2]: brr(n, 4) = Sht.[M2]
    
21.             For j = 5 To UBound(arr, 2)
    
22.                 x = arr(1, j)     '要查找的内容
    
23.                 Set xRng = Sht.UsedRange.Find(x, lookat:=xlWhole)
    
24.                 If Not xRng Is Nothing Then
    
25.                     If j <= UBound(arr, 2) - 6 Then brr(n, j) = xRng.Offset(0, 1) Else brr(n, j) = xRng.Offset(1, 0)
    
26.                 End If
    
27.             Next
    
28.             wb.Close False
    
29.         End If
    
30.     Next
    
31.     Set Sht = Nothing
    
32.     Cells(r, 1).Resize(n, UBound(brr, 2)) = brr
    
33.     Application.ScreenUpdating = True
    
34. End Sub
    
35. Sub zdir(p)       '递归获得本文件夹及所有子文件夹内文件名
    
36.   Set fs = CreateObject("scripting.filesystemobject")
    
37.   For Each f In fs.GetFolder(p).Files
    
38.     If f <> ThisWorkbook.FullName Then s = s + 1: w(s) = f
    
39.   Next
    
40.   For Each m In fs.GetFolder(p).SubFolders
    
41.       zdir m
    
42.   Next
    
43. End Sub

复制代码

安全网

grf1973 发表于 2016-1-25 16:41

打开工作表，找对应名称的数据的代码是哪一句，请老师指教

grf1973

23句

安全网

grf1973 发表于 2016-1-25 22:05
23句

21/22句的5/2/1数据都代表是什么含义了。