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

张雄友 · 发表于 2015-4-3 07:13

本帖最后由张雄友于 2015-4-3 07:51 编辑

提取各月项目，整列提取，指定列提取。

最佳答案

grf1973

2015-4-3 13:19

当然可以。

张雄友 · 发表于 2015-4-3 07:55

其它办法也可以的。

grf1973 · 发表于 2015-4-3 09:51

以前做过的代码小改一下可用。

张雄友 · 发表于 2015-4-3 12:57

grf1973 发表于 2015-4-3 09:51
以前做过的代码小改一下可用。

没有代码的？？还是1楼的附件。

grf1973 · 发表于 2015-4-3 13:07

下载了试试不就知道了？

Sub 导入()
Dim Wb As Workbook, FFF, F, Sh As Worksheet, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim brr(1 To 10000, 1 To 5)
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(ThisWorkbook.Path)
For Each FFF In ff.subfolders
For Each F In FFF.Files
Set Wb = Workbooks.Open(F)
gzb = Replace(Wb.Name, ".xlsx", "") '工作簿名
For Each Sh In Wb.Worksheets '''''''''''''''''''''''''''''''''''''''''''''遍历所有表
Set Rng1 = Sh.UsedRange.Find("工号")
Set Rng2 = Sh.UsedRange.Find("姓名")
Set Rng3 = Sh.UsedRange.Find("实发工资")
If Not Rng1 Is Nothing And Not Rng2 Is Nothing And Not Rng3 Is Nothing Then
c1 = Rng1.Column
c2 = Rng2.Column
c3 = Rng3.Column
r = Sh.Cells(65536, c3).End(3).Row '实发工资列的最大行
arr = Sh.[a1].Resize(r, Application.Max(c1, c2, c3)) '定义数组
For i = Rng1.Row + 1 To UBound(arr) '表头行+1 开始循环
n = n + 1
brr(n, 1) = gzb
brr(n, 2) = Sh.Name
brr(n, 3) = arr(i, c1)
brr(n, 4) = arr(i, c2)
brr(n, 5) = arr(i, c3)
Next
End If
Next '''''''''''''''''''''''''''''''''''''''''''''''遍历所有表
Wb.Close False
Next
Next
With ActiveSheet
.Columns("A:E").Clear
.[a1].Resize(1, 5) = Array("工作簿名", "工作表名", "工号", "姓名", "实发工资")
.[a2].Resize(n, 5) = brr
.[a1].CurrentRegion.Borders.LineStyle = 1
.[a1].CurrentRegion.Columns.AutoFit
End With
End Sub

复制代码

张雄友 · 发表于 2015-4-3 13:13

grf1973 发表于 2015-4-3 13:07
下载了试试不就知道了？

工号，姓名为空的能不能，不显示出来？

grf1973 · 发表于 2015-4-3 13:19

当然可以。

张雄友 · 发表于 2015-4-3 19:13

grf1973 发表于 2015-4-3 13:19
当然可以。

提取后，怎么是10月，11月，12月，再到1月，2月.......的？怎么不是从1月开始的？

grf1973 · 发表于 2015-4-3 21:04

因为dir顺序就是如此。可以先读到数组排序后再打开文件。

张雄友 · 发表于 2015-4-3 21:09

grf1973 发表于 2015-4-3 21:04
因为dir顺序就是如此。可以先读到数组排序后再打开文件。

代码都没有用dir 办法，是用 open 办法打开的，
可以先读到数组排序后再打开文件。（是怎么样的？）

		自动登录	找回密码
密码			注册