- Sub yy()
- Dim i&, Myr&, j&, Arr, r%, Arr1(), ks&, js%, bt, rq, Brr
- Sheet1.Activate
- Cells.ClearContents
- Myr = Sheet2.[a65536].End(xlUp).Row
- Arr = Sheet2.Range("a1:p" & Myr)
- For i = 5 To UBound(Arr)
- If Arr(i, 1) = "部门编号" Then
- r = r + 1
- ReDim Preserve Arr1(1 To r)
- Arr1(r) = i
- End If
- Next
- bt = Array("部门编号", "员工编号", "部门名称", "员工姓名")
- For i = 1 To r
- If i <> r Then
- js = Arr1(i + 1) - 2
- Else
- js = Myr
- End If
- ks = Arr1(i) + 2
- If i = 1 Then
- [a1].Resize(1, 4) = bt
- rq = Sheet2.Cells(ks, 1).Resize(js - ks + 1, 1)
- [e1].Resize(1, UBound(rq)) = Application.Transpose(rq)
- ReDim Brr(1 To r, 1 To UBound(rq) + 4)
- End If
- Brr(i, 1) = Arr(Arr1(i), 2)
- Brr(i, 2) = Arr(Arr1(i) + 1, 2)
- Brr(i, 3) = Arr(Arr1(i), 5)
- Brr(i, 4) = Arr(Arr1(i) + 1, 5)
- For j = ks To js
- Set r1 = Rows(1).Find(Arr(j, 1))
- Brr(i, r1.Column) = Arr(j, 16)
- Next
- Next
- [a2].Resize(r, UBound(Brr, 2)) = Brr
- End Sub
复制代码 |