前两天发一个提取A4版本的
其中因为A4版本的内容是
(1)前5行内容一致
(2)5行后根据个人的不同后面有不同的内容
所以我费了九N二H的力量,根据不同的内容做出不同的判断提取不同的内容到不同的单元格。(你看表达都这么麻烦,设计一定也不容易)
【解决来了】
今天下载了一个A3版本的,
简单是太完美啦
发现在A3版本的内容都是固定单元格的啦。
(1)只要我们找到要提取的内容的单元格(涂色的),放在第一行,如下图
再根据读取第一行的内容到数组,就可以得到列总数
(2)再读取文件的总个数就可以得到行总数,Redim一个数组(行总数,列总数)
(3)运行程序,自动循环逐一个打开Excel文件,读取第一行指定的单元格到汇总表
就可以轻松完完成数据的提取啦,3K左右个文件,400多秒就提取完成。完美,
【代码】
Sub yhd一键提取广东省工资系统个人信息A3版本()
Dim mysht As Worksheet
Dim fold As String, file, data_arr()
Dim myobj As Object
Dim file_num
file_num = 0
Set mysht = Sheets("提取A3")
fold = SelectGetFolder
If fold = "没有选择" Then Exit Sub
arr = GetPathAllFile(fold)
Call AppEx(False)
ti = Timer()
With mysht
.Range("a5").Resize(5000, 200).ClearContents
xl_c = .Range("A1").End(xlToRight).Column
ReDim data_arr(UBound(arr) - 1, xl_c - 1)
start_arr = .Range("A1").Resize(2, xl_c)
Debug.Print UBound(start_arr, 2), UBound(data_arr, 1) & "--" & UBound(data_arr, 2)
End With
For Each rr In arr
Set myobj = GetObject(rr)
With myobj
With .Sheets("Sheet1")
For i = 1 To xl_c
data_arr(file_num, i - 1) = .Range(start_arr(1, i))
Next i
End With
.Close False
End With
file_num = file_num + 1
Set myobj = Nothing
Next
With mysht.Range("a5").Resize(UBound(data_arr, 1) + 1, UBound(data_arr, 2) + 1)
.NumberFormatLocal = "@"
.Value = data_arr 'Application.Transpose(arr)
.ShrinkToFit = True
End With
Call AppEx(True)
MsgBox "完成!用时" & Format(Timer - ti, "0000.00秒")
End Sub
代码放在此,可供自己和有用的人学习使用,如有问题,可向我提问
【效果】
你的点赞与赞赏是我前进的动力,
感谢!