|
本帖最后由 sunya_0529 于 2019-6-24 09:31 编辑
这个需求只能用VBA来解决了,效果如下图所示——
代码如下所示——
- Option Explicit
- Sub 提取分布名单()
- 'On Error Resume Next
- Dim dic As Object, rng As Range, a(1 To 19, 2), b(9999, 4), c, d, h%, i%, j%, k%
- Dim str1$
- Set dic = CreateObject("Scripting.Dictionary")
- With Sheets("1人员明细表")
- For Each rng In .Range("A2:A" & .[A65536].End(xlUp).Row)
- If Not dic.exists(rng.Value) Then
- h = h + 1
- dic.Add rng.Value, ""
- a(h, 0) = rng.Value
- a(h, 1) = IIf(rng.Offset(0, 1).Value = "安全", rng.Offset(0, 2).Value, "")
- a(h, 2) = IIf(rng.Offset(0, 1).Value = "安全", "", rng.Offset(0, 2).Value)
- Else
- a(h, 1) = a(h, 1) & IIf(rng.Offset(0, 1).Value = "安全", IIf(Len(a(h, 1)) > 0, ",", "") & rng.Offset(0, 2).Value, "")
- a(h, 2) = a(h, 2) & IIf(rng.Offset(0, 1).Value = "安全", "", IIf(Len(a(h, 2)) > 0, ",", "") & rng.Offset(0, 2).Value)
- End If
- Next
- End With
- Set dic = Nothing
- For i = 1 To UBound(a)
- b(k, 0) = a(i, 0)
- c = Split(a(i, 1), ",")
- d = Split(a(i, 2), ",")
- For j = 0 To Application.Max(Application.RoundUp((UBound(c) + 1) / 2, 0) - 1, Application.RoundUp((UBound(d) + 1) / 2, 0) - 1, 0)
- If UBound(c) >= j * 2 Then b(k, 1) = c(j * 2)
- If UBound(c) >= j * 2 + 1 Then b(k, 2) = c(j * 2 + 1)
- If UBound(d) >= j * 2 Then b(k, 3) = d(j * 2)
- If UBound(d) >= j * 2 + 1 Then b(k, 4) = d(j * 2 + 1)
- k = k + 1
- Next j
- Next i
- With ActiveSheet
- .[A:E].Clear
- .[A1] = "公司人员分布"
- .[A1:E1].Merge
- .[A2] = "项目名称"
- .[B2] = "安全"
- .[B2:C2].Merge
- .[D2] = "办公室"
- .[D2:E2].Merge
- .[A1:E2].HorizontalAlignment = xlCenter
- '.[A1:E2].VerticalAlignment = xlCenter
- .[A3].Resize(UBound(b), 5) = b
- End With
- End Sub
复制代码
|
|