|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
代码如下。。。。
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, rg As Range
Set wb = ThisWorkbook
p = wb.Path & "\"
f = Dir(p & "*.xls*")
ReDim brr(1 To 10000, 1 To 6)
Do While f <> ""
If f <> wb.Name Then
With Workbooks.Open(p & f, 0).Sheets(1)
Set rng = .UsedRange.Find("姓名")
s = rng.Offset(, 1).Value
Set rng = .UsedRange.Find("履历类别")
d = Split(rng.Address, "$")(2)
Set rg = .UsedRange.Find("称谓")
d1 = Split(rg.Address, "$")(2)
arr = rng.Offset(1).Resize(d1 - d - 1, 7)
For i = 1 To UBound(arr)
If arr(i, 1) <> Empty Then
n = n + 1
brr(n, 1) = s
For j = 1 To 4
brr(n, j + 1) = arr(i, j)
Next
brr(n, 6) = arr(i, UBound(arr, 2))
End If
Next
.Parent.Close 0
End With
End If
f = Dir
Loop
With wb.Sheets(1)
.UsedRange.Clear
.[a2] = "履历信息汇总"
.[a2].Resize(, 6).Merge
.[a3:f3] = [{"姓名","履历类别","起始时间","结束时间","所在单位","身份或职务"}]
.[a4].Resize(n, 6) = brr
.UsedRange.Offset(1).Borders.LineStyle = 1
.UsedRange.HorizontalAlignment = xlCenter
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
Beep
End Sub
|
|