- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 257
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-11-28
|
¦^´_ 6# b9208 - Sub ex()
- Set dic = CreateObject("Scripting.Dictionary")
- Set dic1 = CreateObject("Scripting.Dictionary")
- Set dic2 = CreateObject("Scripting.Dictionary")
- With Sheets("List")
- If .[H6].End(xlDown).Row = .Rows.Count Then MsgBox "µL¸ê®Æ": Exit Sub 'µL¸ê®Æ
- For Each a In .Range(.[H6], .[H65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
- ar = Split(a, "+")
- For Each c In ar
- mystr = c & "," & Left(a.Offset(, 3), 8) & "," & a.Offset(, 8)
- dic1(mystr) = Split(mystr, ",")
- Next
- Next
- End With
- With Sheets("©ú²Ó")
- ay = Application.Transpose(Application.Transpose(dic1.items))
- For i = 1 To UBound(ay, 1)
- mystr = ay(i, 1) & ay(i, 2)
- dic2(ay(i, 1)) = dic2(ay(i, 1)) + 1
- If IsEmpty(dic(mystr)) Then
- ary = Array(ay(i, 1), ay(i, 2), 1)
- Else
- ary = dic(mystr)
- ary(2) = ary(2) + 1
- End If
- dic(mystr) = ary
- Next
- With .[B3].Resize(dic.Count, 3)
- .Value = Application.Transpose(Application.Transpose(dic.items))
- .Sort key1:=.Cells(1, 1), Header:=xlNo
- For Each a In .Columns(1).Cells
- If a <> a.Offset(-1, 0) Then a.Offset(, 3) = dic2(a.Value)
- Next
- End With
- .[I3].Resize(dic2.Count, 1) = Application.Transpose(dic2.keys)
- .[J3].Resize(dic2.Count, 1) = Application.Transpose(dic2.items)
- End With
- End Sub
½Æ»s¥N½X |
|