|
本帖最后由 1032446692 于 2013-5-27 14:09 编辑
Option Explicit
Sub test()
Dim a, i, k, st, arra, arrb, diction, dictiona
Set diction = CreateObject("scripting.dictionary")
Set dictiona = CreateObject("scripting.dictionary")
Sheets(1).Select
a = Cells(60000, 1).End(xlUp).Row
arra = Cells(1, 1).Resize(a)
ReDim arrb(1 To a, 1 To a + 1)
For i = 1 To a
st = Left(arra(i, 1), InStr(1, arra(i, 1), "_") - 1)
If diction.exists(st) Then
dictiona(st) = dictiona(st) + 1
arrb(diction(st), dictiona(st)) = arra(i, 1)
Else
k = k + 1
diction(st) = k
dictiona(st) = 2
arrb(k, 1) = st
arrb(k, 2) = arra(i, 1)
End If
Next i
Sheets(2).Cells(2, 1).Resize(a, a + 1) = arrb
End Sub
|
|