|
附件表2模拟的不走心,仅供参考。
- Sub test()
- Dim arr, brr, i%, j%, n%, k
- Dim dic As Object
- Set dic = CreateObject("scripting.dictionary")
- arr = Range("A3").CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 9)
- n = 2
- k = 2
- For j = 3 To UBound(arr, 2) Step 6
- n = n + 3
- brr(1, n) = arr(2, j - 1)
- Cells(26, n).Resize(1, 3).Merge
- For i = 4 To UBound(arr)
- If arr(i, j) <> "" Then
- If Not dic.exists(arr(i, j)) Then k = k + 1: dic(arr(i, j)) = k
- End If
- If arr(i, j) = "" Then
- brr(i, n) = ""
- brr(i, n + 1) = ""
- brr(i, n + 2) = ""
- Else
- brr(dic(arr(i, j)), 1) = dic(arr(i, j)) - 2
- brr(dic(arr(i, j)), 2) = "人事部"
- brr(dic(arr(i, j)), 3) = arr(i, j)
- brr(dic(arr(i, j)), 4) = arr(i, j + 1)
- brr(dic(arr(i, j)), n) = arr(i, j + 2)
- brr(dic(arr(i, j)), n + 1) = arr(i, j + 3)
- brr(dic(arr(i, j)), n + 2) = arr(i, j + 4)
- End If
- Next
- Next
- n = 0
- For j = 1 To UBound(arr, 2)
- If j > 4 Then
- If InStr("单位姓名账号", arr(3, j)) = 0 Then
- n = n + 1
- brr(2, n) = arr(3, j)
- End If
- Else
- n = n + 1
- brr(2, n) = arr(3, j)
- End If
- Next
- With [a26].Resize(UBound(brr), UBound(brr, 2))
- .ClearContents
- .Borders.Weight = xlThin
- .HorizontalAlignment = xlVAlignCenter
- End With
- With [a26].Resize(1, UBound(brr, 2))
- .Interior.ColorIndex = 36
- .Offset(1).Font.Color = 255
- .Offset(1).Interior.ColorIndex = 35
- .Offset(1).Resize(UBound(brr) - 1, 2).Interior.ColorIndex = 35
- End With
- [a26].Resize(UBound(brr), UBound(brr, 2)) = brr
- End Sub
复制代码 |
|