|
楼主 |
发表于 2013-4-9 10:17
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
字典法:当然里面也有数组了。
- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Row <> 1 Or Target.Column <> 3 Then Exit Sub
- Application.ScreenUpdating = False
- Application.EnableEvents = False
- Dim ir As Integer
- Dim i As Integer
- Dim arr As Variant
- Dim ar As Variant
- Dim brr()
- Dim dic As Object
- Set dic = CreateObject("scripting.dictionary")
- With Sheets("原始数据")
- ir = .[a65536].End(xlUp).Row
- arr = .Range("a2:e" & ir)
- For i = 1 To ir - 1
- If arr(i, 1) = Range("c1") Then
- If Not dic.exists(arr(i, 1)) Then
- dic(arr(i, 1)) = dic(arr(i, 1)) & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5)
- Else
- dic(arr(i, 1)) = dic(arr(i, 1)) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5)
- End If
- End If
- Next
- ar = dic.items
- s = UBound(Split(ar(0), ",")) + 1
- ReDim brr(1 To s / 4, 1 To 4)
- For j = 1 To s / 4
- For t = 1 To 4
- brr(j, t) = Split(ar(0), ",")(k)
- k = k + 1
- Next t
- Next j
- End With
- Range("b4").Resize(UBound(brr), 4) = brr
- Range("a4") = Range("c1")
- Range("a4:a" & UBound(brr) + 3).FillDown
- Application.EnableEvents = True
- Application.ScreenUpdating = True
- End Sub
复制代码
|
|