|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub kk()
Dim dic As Object, arr(), brr()
Set dic = CreateObject("scripting.dictionary")
With Sheet1
arr = .Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 20)
For i = 2 To UBound(arr)
x = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
If dic.exists(x) = False Then
k = 4
n = n + 1
dic(x) = n
brr(n, k) = arr(i, 4)
a = k
Else
a = a + 1
brr(n, a) = arr(i, 4)
End If
m = dic(x)
brr(m, 1) = arr(i, 1)
brr(m, 2) = arr(i, 2)
brr(m, 3) = arr(i, 3)
Next i
.Range("H18").Resize(n, 20).Cells.ClearContents
.Range("H18").Resize(n, 20) = brr
End With
End Sub
|
|