ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

½Ð±Ð¥ý¶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)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

¦^´_ 1# b9208
  1. Sub ex()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Set dic1 = CreateObject("Scripting.Dictionary")
  4. Set dic2 = CreateObject("Scripting.Dictionary")

  5. With Sheets("List")
  6. For Each a In .Range(.[H6], .[H65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
  7. ar = Split(a, "+")
  8.    For Each c In ar
  9.       mystr = c & "," & Left(a.Offset(, 3), 8) & "," & a.Offset(, 8)
  10.       dic1(mystr) = Split(mystr, ",")
  11.    Next
  12. Next
  13. End With
  14. With Sheets("©ú²Ó")
  15. ay = Application.Transpose(Application.Transpose(dic1.items))
  16. For i = 1 To UBound(ay, 1)
  17.    mystr = ay(i, 1) & ay(i, 2)
  18.    dic2(ay(i, 1)) = dic2(ay(i, 1)) + 1
  19.    If IsEmpty(dic(mystr)) Then
  20.      ary = Array(ay(i, 1), ay(i, 2), 1)
  21.    Else
  22.      ary = dic(mystr)
  23.      ary(2) = ary(2) + 1
  24.    End If
  25.    dic(mystr) = ary
  26. Next
  27. With .[B3].Resize(dic.Count, 3)
  28. .Value = Application.Transpose(Application.Transpose(dic.items))
  29. .Sort key1:=.Cells(1, 1), header:=xlNo
  30. For Each a In .Columns(1).Cells
  31. If a <> a.Offset(-1, 0) Then a.Offset(, 3) = dic2(a.Value)
  32. Next
  33. End With
  34. End With
  35. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh


    ÁÂÁ ¦n¥Îªº·Qªk ©M¸Ñµª
    ¬B°_ ¥H«á¦³¾÷·|¥i¥H¥Î...
50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 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
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 4# b9208
  1. Sub ex()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Set dic1 = CreateObject("Scripting.Dictionary")
  4. Set dic2 = CreateObject("Scripting.Dictionary")

  5. With Sheets("List")
  6. If .[H6].End(xlDown).Row = .Rows.Count Then MsgBox "µL¸ê®Æ": Exit Sub  'µL¸ê®Æ
  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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

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

TOP

¦^´_ 6# b9208
  1. Sub ex()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. Set dic1 = CreateObject("Scripting.Dictionary")
  4. Set dic2 = CreateObject("Scripting.Dictionary")

  5. With Sheets("List")
  6. If .[H6].End(xlDown).Row = .Rows.Count Then MsgBox "µL¸ê®Æ": Exit Sub  'µL¸ê®Æ
  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. .[I3].Resize(dic2.Count, 1) = Application.Transpose(dic2.keys)
  36. .[J3].Resize(dic2.Count, 1) = Application.Transpose(dic2.items)
  37. End With
  38. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 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)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

        ÀR«ä¦Û¦b : «Î¼e¤£¦p¤ß¼e¡C
ªð¦^¦Cªí ¤W¤@¥DÃD