电力的吧?同行看看满足要求不
- Sub test()
- Dim n, i, j, arr, brr, Keys, Its, it
- Dim dic
- Set dic = CreateObject("scripting.dictionary")
- With Sheet1
- arr = .UsedRange
- For i = 2 To UBound(arr)
- n = Split(arr(i, 4), "、")
- For j = 0 To UBound(n)
- If Not dic.exists(n(j)) Then
- dic(n(j)) = i
- Else
- dic(n(j)) = dic(n(j)) & "_" & i
- End If
- Next
- Next
- End With
- Keys = dic.Keys
- Its = dic.Items
- With Sheet2
- .Range("c2:d" & .UsedRange.Rows.Count).ClearContents
- brr = .UsedRange
- For i = 2 To UBound(brr)
- If dic.exists(brr(i, 2) & "") Then
- it = Split(dic(brr(i, 2) & ""), "_")
- For j = 0 To UBound(it)
- If arr(it(j), 2) = "检修" Then
- brr(i, 4) = arr(it(j), 1) & "、" & brr(i, 4)
- Else
- brr(i, 3) = arr(it(j), 1) & "、" & brr(i, 3)
- End If
- Next
- End If
- Next
- For i = 2 To UBound(brr)
- For j = 3 To 4
- If brr(i, j) <> "" Then
- brr(i, j) = Left(brr(i, j), Len(brr(i, j)) - 1)
- End If
- Next
- Next
- .Cells(1, 1).Resize(UBound(brr, 1), UBound(brr, 2)) = brr
- End With
- End Sub
复制代码 |