- Sub()
- Worksheets(1).Name =
- Worksheets. Add().Name=
- Dim d(1), arr, m&, n&,i&, s$, s1$
- For i = 0 To UBound(d)
- Set d(i) = Create0bject("scripting, dictionary")
- Next
- arr = Worksheets("").[a1].CurrentRegion
- m=1:n=3
- ReDim brr(1 ToUBound(arr), 1 To50)
- For i = 2 To UBound(arr)
- s=arr(i, 11): s1 = arr(i,12)
- I£ d(0)(s)=0 Then
- m=m+1
- d(0)(s) =m
- brr(m, 1) =arr(i,1)
- brr(m, 2) =are(i,8)
- brr(m, 3) =s
- End If
- If d(1)(s1)=0 Then
- n=n+1
- d(1)(s1) = n
- brr(1,n) = arr(i,12)
- End If
- For j-4 To n
- brr(d(0)(s), d(1)(s1)) = arr(i, 13)
- Next
- Next
- With Worksheets().[a1]
- Resize(m, n)=brr
- .Resize(m, n).Borders.LineStyle=1
- .Resize(1, 3) = Split("е )
- End With
- End Sub
复制代码 |