|
发表于 2017-7-24 16:36
|
显示全部楼层
本楼为最佳答案
- Sub tt()
- arr = Sheet1.[a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- ReDim brr(1 To UBound(arr), 1 To 3)
- For i = 3 To UBound(arr)
- x = arr(i, 6): p = IIf(arr(i, 9) = "属实", 2, 3)
- If Not d.exists(x) Then
- n = n + 1: d(x) = n
- brr(n, 1) = x
- End If
- brr(d(x), p) = brr(d(x), p) + 1
- Next
- For i = 1 To n
- x = Val(brr(i, 2)): y = Val(brr(i, 3))
- brr(i, 2) = "不属实的" & y & "条属实的" & x & "条"
- brr(i, 3) = x + y & "条"
- Next
- With Sheet2
- .[a2].Resize(1000, 3).ClearContents
- .[a2].Resize(n, 3) = brr
- .Activate
- End With
- End Sub
复制代码 |
|