[已解决]选择性提取各月项目

grf1973

这么办

1. Sub 导入()
   
2.     'http://www.excelpx.com/forum-5-1.html
   
3.     Dim Wb As Workbook, FFF, F, Sh As Worksheet, Rng1 As Range, Rng2 As Range, Rng3 As Range
   
4.     Dim brr(1 To 10000, 1 To 5), crr()
   
5.     Set fso = CreateObject("scripting.filesystemobject")
   
6.     Set ff = fso.getfolder(ThisWorkbook.Path)
   
7.     For Each FFF In ff.subfolders
   
8.        nf = Replace(FFF, ff & "", "")          '年份
   
9.        ReDim crr(1 To 12)                 '对应1--12月份，排序
   
10.        For Each F In FFF.Files
    
11.             yf = Val(Split(F, "")(UBound(Split(F, ""))))            '月份
    
12.             crr(yf) = F            '按月份放到数组对应位置
    
13.         Next
    
14.         For p = 1 To 12
    
15.             F = crr(p)
    
16.             If Len(F) > 0 Then
    
17.                  Set Wb = Workbooks.Open(F)
    
18.                  gzb = Replace(Wb.Name, ".xlsx", "")            '工作簿名(加年份）
    
19.                  For Each Sh In Wb.Worksheets '''''''''''''''''''''''''''''''''''''''''''''遍历所有表
    
20.                     Set Rng1 = Sh.UsedRange.Find("工号")
    
21.                     Set Rng2 = Sh.UsedRange.Find("姓名")
    
22.                     Set Rng3 = Sh.UsedRange.Find("实发工资")
    
23.                     If Not Rng1 Is Nothing And Not Rng2 Is Nothing And Not Rng3 Is Nothing Then
    
24.                          c1 = Rng1.Column
    
25.                          c2 = Rng2.Column
    
26.                          c3 = Rng3.Column
    
27.                          r = Sh.Cells(65536, c3).End(3).Row         '实发工资列的最大行
    
28.                          arr = Sh.[a1].Resize(r, Application.Max(c1, c2, c3))     '定义数组
    
29.                          For i = Rng1.Row + 1 To UBound(arr)       '表头行+1 开始循环
    
30.                             If Len(arr(i, c1) & arr(i, c2)) > 0 Then
    
31.                                 n = n + 1
    
32.                                 brr(n, 1) = nf & "" & Wb.Name
    
33.                                 brr(n, 2) = Sh.Name
    
34.                                 brr(n, 3) = arr(i, c1)
    
35.                                 brr(n, 4) = arr(i, c2)
    
36.                                 brr(n, 5) = arr(i, c3)
    
37.                             End If
    
38.                         Next
    
39.                     End If
    
40.                 Next '''''''''''''''''''''''''''''''''''''''''''''''遍历所有表
    
41.                 Wb.Close False
    
42.             End If
    
43.        Next
    
44.     Next
    
45.     With ActiveSheet
    
46.         .Columns("A:E").Clear
    
47.         .[a1].Resize(1, 5) = Array("工作簿名", "工作表名", "工号", "姓名", "实发工资")
    
48.         .[a2].Resize(n, 5) = brr
    
49.         .[a1].CurrentRegion.Borders.LineStyle = 1
    
50.         .[a1].CurrentRegion.Columns.AutoFit
    
51.     End With
    
52. End Sub
    

复制代码

grf1973

思路是先求出月份，然后把月份放到数组对应位置，比如5月放到crr(5),10月放到crr(10)....然后对crr从1到12开始循环。这样自然就按月份排序了。

张雄友

grf1973 发表于 2015-4-4 20:50
思路是先求出月份，然后把月份放到数组对应位置，比如5月放到crr(5),10月放到crr(10)....然后对crr从1到12开 ...

把，2014，2015，这二个文件夹放入 2013内，就无法提取了。只提取到2013的。

grf1973

把2014，2015，这二个文件夹放入 2013。。。。。。你这是在自找麻烦？一般人会这么干？

张雄友

grf1973 发表于 2015-4-5 04:42
把2014，2015，这二个文件夹放入 2013。。。。。。你这是在自找麻烦？一般人会这么干？

睡不着，早上4点起来搞到现在没搞好。next 没有for .

grf1973

你的逻辑关系整个全乱了。重新整了一下。至于排序，用辅助列在工作表内排，要简单很多。

张雄友

grf1973 发表于 2015-4-5 14:54
你的逻辑关系整个全乱了。重新整了一下。至于排序，用辅助列在工作表内排，要简单很多。

用了几天，出问题了。
1月份没有姓名这列，就所有数据都提取不到了。如果找不到姓名这列，就姓名这列不用提取，提取工号，实发工资。
就是姓名这列空出来。就是说哪一列找不到就照样提取，只是空出来。实现效果！

grf1973

。。。。。。。。。。。。。。

张雄友

grf1973 发表于 2015-4-13 16:31
。。。。。。。。。。。。。。

   For i = Rng3.Row + 1 To UBound(arr)       '表头行+1 开始循环

with 块变量未设置。

grf1973

你可真能折腾