[µo°Ý] ¨Ì¿z¿ï±ø¥ó¿é¥X©ú²Ó¨Ã²Î­p

b9208

½Ð±Ð¥ý¶i¡I
¨Ìªþ¥óÀɤ¤
¡ªLIST¡ª¤u§@ªí¤¤Äæ¦ì¡ªª««~¡ª(H)³æ¶µ¥H¡ª+¡ª¤À¶}¡A¥B¥X³f®É¶¡(K)¤§¤é´Á¤Î¯Z§O(P)¬Û¦P¡A«h¥u²Î­p¤@µ§¸ê®Æ¡C
¿z¿ï¥X¤§¸ê®Æ¿é¥X©ó¡ª©ú²Ó¡ª¤u§@ªí¤¤¡A¨Ã¨Ì¡uª««~³æ¶µ¡v¤Î¡u¤é´Á¡v±Æ§Ç¡C
½Ð°Ñ¦ÒªþÀÉ¡C
ÁÂÁ«ü¾É

B1.rar (9.01 KB)

¤U¸ü¦¸¼Æ: 32

2012-9-30 21:42

Hsieh

¦^´_ 1# b9208

1. Sub ex()
   
2. Set dic = CreateObject("Scripting.Dictionary")
   
3. Set dic1 = CreateObject("Scripting.Dictionary")
   
4. Set dic2 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. With Sheets("List")
   
7. For Each a In .Range(.[H6], .[H65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
   
8. ar = Split(a, "+")
   
9.    For Each c In ar
   
10.       mystr = c & "," & Left(a.Offset(, 3), 8) & "," & a.Offset(, 8)
    
11.       dic1(mystr) = Split(mystr, ",")
    
12.    Next
    
13. Next
    
14. End With
    
15. With Sheets("©ú²Ó")
    
16. ay = Application.Transpose(Application.Transpose(dic1.items))
    
17. For i = 1 To UBound(ay, 1)
    
18.    mystr = ay(i, 1) & ay(i, 2)
    
19.    dic2(ay(i, 1)) = dic2(ay(i, 1)) + 1
    
20.    If IsEmpty(dic(mystr)) Then
    
21.      ary = Array(ay(i, 1), ay(i, 2), 1)
    
22.    Else
    
23.      ary = dic(mystr)
    
24.      ary(2) = ary(2) + 1
    
25.    End If
    
26.    dic(mystr) = ary
    
27. Next
    
28. With .[B3].Resize(dic.Count, 3)
    
29. .Value = Application.Transpose(Application.Transpose(dic.items))
    
30. .Sort key1:=.Cells(1, 1), header:=xlNo
    
31. For Each a In .Columns(1).Cells
    
32. If a <> a.Offset(-1, 0) Then a.Offset(, 3) = dic2(a.Value)
    
33. Next
    
34. End With
    
35. End With
    
36. End Sub

½Æ»s¥N½X

softsadwind

¦^´_ 2# Hsieh


    ÁÂÁ ¦n¥Îªº·Qªk ©M¸Ñµª
    ¬B°_ ¥H«á¦³¾÷·|¥i¥H¥Î...

b9208

¦^´_ 2# Hsieh
«D±`·PÁÂ¥ý¶i
°õ¦æ¥i¥H¨Ï¥Î
²Å¦X»Ý¨D
¦A¤@¦¸ÁÂÁÂ

¥t·í¡ªList¡ª¤§H6¥H¤UÄæ¦ì¨S¦³¸ê®Æ®É¡A«h¿ù»~¡C
¥Ø«e¥¿¬ã¨s¦p¦ó±Æ¸Ñ¡AÅã¥Ü³qª¾¨ÃÂ÷¶}µ{¦¡¡C

Hsieh

¦^´_ 4# b9208

1. Sub ex()
   
2. Set dic = CreateObject("Scripting.Dictionary")
   
3. Set dic1 = CreateObject("Scripting.Dictionary")
   
4. Set dic2 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. With Sheets("List")
   
7. If .[H6].End(xlDown).Row = .Rows.Count Then MsgBox "µL¸ê®Æ": Exit Sub  'µL¸ê®Æ
   
8. For Each a In .Range(.[H6], .[H65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
   
9. ar = Split(a, "+")
   
10.    For Each c In ar
    
11.       mystr = c & "," & Left(a.Offset(, 3), 8) & "," & a.Offset(, 8)
    
12.       dic1(mystr) = Split(mystr, ",")
    
13.    Next
    
14. Next
    
15. End With
    
16. With Sheets("©ú²Ó")
    
17. ay = Application.Transpose(Application.Transpose(dic1.items))
    
18. For i = 1 To UBound(ay, 1)
    
19.    mystr = ay(i, 1) & ay(i, 2)
    
20.    dic2(ay(i, 1)) = dic2(ay(i, 1)) + 1
    
21.    If IsEmpty(dic(mystr)) Then
    
22.      ary = Array(ay(i, 1), ay(i, 2), 1)
    
23.    Else
    
24.      ary = dic(mystr)
    
25.      ary(2) = ary(2) + 1
    
26.    End If
    
27.    dic(mystr) = ary
    
28. Next
    
29. With .[B3].Resize(dic.Count, 3)
    
30. .Value = Application.Transpose(Application.Transpose(dic.items))
    
31. .Sort key1:=.Cells(1, 1), Header:=xlNo
    
32. For Each a In .Columns(1).Cells
    
33. If a <> a.Offset(-1, 0) Then a.Offset(, 3) = dic2(a.Value)
    
34. Next
    
35. End With
    
36. End With
    
37. End Sub

½Æ»s¥N½X

b9208

¦^´_ 5# Hsieh
Dear Hsieh,
«D±`·PÁ°õ¦æ³£ok
¦]¸ê®Æµ§¼Æ«Ü¦h¡A©Ò¥H¬d¬ÝSubTotal ¸ê®Æ¤£¤è«K¡A
¤µ·Q©ó¡ª©ú²Ó¡ª¤u§@ªí¤º[I3]¿é¥X¡ªª««~³æ¶µ¡ª¤Î[J3]¿é¥X¡ªSubTotal¡ª¡C
Àµ½Ð«ü¾É
ÁÂÁÂ

Hsieh

¦^´_ 6# b9208

1. Sub ex()
   
2. Set dic = CreateObject("Scripting.Dictionary")
   
3. Set dic1 = CreateObject("Scripting.Dictionary")
   
4. Set dic2 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. With Sheets("List")
   
7. If .[H6].End(xlDown).Row = .Rows.Count Then MsgBox "µL¸ê®Æ": Exit Sub  'µL¸ê®Æ
   
8. For Each a In .Range(.[H6], .[H65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
   
9. ar = Split(a, "+")
   
10.    For Each c In ar
    
11.       mystr = c & "," & Left(a.Offset(, 3), 8) & "," & a.Offset(, 8)
    
12.       dic1(mystr) = Split(mystr, ",")
    
13.    Next
    
14. Next
    
15. End With
    
16. With Sheets("©ú²Ó")
    
17. ay = Application.Transpose(Application.Transpose(dic1.items))
    
18. For i = 1 To UBound(ay, 1)
    
19.    mystr = ay(i, 1) & ay(i, 2)
    
20.    dic2(ay(i, 1)) = dic2(ay(i, 1)) + 1
    
21.    If IsEmpty(dic(mystr)) Then
    
22.      ary = Array(ay(i, 1), ay(i, 2), 1)
    
23.    Else
    
24.      ary = dic(mystr)
    
25.      ary(2) = ary(2) + 1
    
26.    End If
    
27.    dic(mystr) = ary
    
28. Next
    
29. With .[B3].Resize(dic.Count, 3)
    
30. .Value = Application.Transpose(Application.Transpose(dic.items))
    
31. .Sort key1:=.Cells(1, 1), Header:=xlNo
    
32. For Each a In .Columns(1).Cells
    
33. If a <> a.Offset(-1, 0) Then a.Offset(, 3) = dic2(a.Value)
    
34. Next
    
35. End With
    
36. .[I3].Resize(dic2.Count, 1) = Application.Transpose(dic2.keys)
    
37. .[J3].Resize(dic2.Count, 1) = Application.Transpose(dic2.items)
    
38. End With
    
39. End Sub

½Æ»s¥N½X

b9208

¦^´_ 7# Hsieh
Dear Hsieh
¼W¥[¿z¿ï±ø¥ó¡GList¤u§@ªíCÄæ¡u³æ¦ì¡v¡A²Å¦X©ú²Ó¤u§@ªíA 2 Àx¦s®æ³æ¦ì¡A¤~²Î­p¿é¥X¸ê®Æ¡C
¦pªþ¥ó¤º¬õ¦â¼Ð¥Ü°Ï
«D±`·PÁ«ü¾É
B2.rar (8.14 KB)

¤U¸ü¦¸¼Æ: 7

2014-2-8 15:04