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

[µo°Ý] VBA counta

[µo°Ý] VBA counta

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-5-15 10:00 ½s¿è

§Ú¦³¤@²Õ¼Æ¦r¦pSheet1 A,·QDelete ¥kÃä³Ì«á4­Ó¦r ¤§«á¦Acounta ¨C­Ó¦r¦³´X¦h­Ó¬O­«½Æ.

½Ð°Ý¥ÎVBA«ç»ò¼g

Sheet1
        A
ref+plt no
01J050701-001
01J050701-002
02J050703-005
02J050706-002
02J050706-003
02J050706-001

Sheet2           count
01J050701        2
02J050703        1
02J050706        3

¨þ¨þ¨þ~ §Ú¥u·|¥Î°j°éºâ...

Book1.rar (7.03 KB)

­Y¬O§Ú¦^µª¡A¨Ï±zº¡·N¡A½Ð±zÅý§Úª¾¹D¡I                  
­Y¬O§Úªº¦^ÂСA±z¤´¦³¨ä¥L¨£¸Ñ¡A¤]½Ð±z¤£¶Þ«ü±Ð¡I

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-5-15 10:04 ½s¿è
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each a In Range([A1], [A65536].End(xlUp))
  4.    d(Split(a, "-")(0)) = d(Split(a, "-")(0)) + 1
  5. Next
  6. [B1].Resize(d.Count, 1) = Application.Transpose(d.keys)
  7. [C1].Resize(d.Count, 1) = Application.Transpose(d.items)
  8. End Sub
½Æ»s¥N½X
Book1.rar (8.99 KB)
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

  1. Sub Ex()
  2.     Dim D As Object, E As Range, Ar
  3.     Set D = CreateObject("Scripting.Dictionary")
  4.     For Each E In Sheet1.Range("A1", Sheet1.Range("A1").End(xlDown))
  5.         If D.exists((Split(E, "-")(0))) Then
  6.             Ar = D(Split(E, "-")(0))(1)
  7.             D(Split(E, "-")(0)) = Array(Split(E, "-")(0), Ar + 1)
  8.         Else
  9.             D(Split(E, "-")(0)) = Array(Split(E, "-")(0), 1)
  10.         End If
  11.     Next
  12.     Sheet2.[B1].Resize(D.Count, 2) = Application.Transpose(Application.Transpose(D.items))
  13. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-5-16 21:57 ½s¿è

¦hÁ¨â¦ì¦Ñ®vªº«ü±Ð,¤£¹L§Ú·|¥Îhsiehªº¼gªk,¦n¹³©öÀ´¨Ç.
¥t¥~,§Ú¦³®É¬Ý¤@¨Ç¼gªk,³ßÅw¦b³Ì«á¥[¤W ¥H¤U2¥y...·Q°Ý¤@¤U¨ì©³¦³¤°»ò§@¥Î??
   Set myRng1 = Nothing
    Set myRng2 = Nothing

------------
¦]¬°­n¦bA ¥[¨Çitem no,©Ò¥H......§Úªº¼gªk
Set E = CreateObject("Scripting.Dictionary")

For Each a In Range([B1], [B65536].End(xlUp))

E(Split(a, "-")(0)) = E(Split(a, "-")(0)) + 1

Next

[C1].Resize(E.Count, 1) = Application.Transpose(E.keys)

[D1].Resize(E.Count, 1) = Application.Transpose(E.items)


  Dim myRng1 As Range
    Dim myRng2 As Range
    Set myRng1 = Worksheets("Sheet1").Range("C:D")
    Set myRng2 = Worksheets("Sheet2").Range("A:B")
   
    myRng1.Copy Destination:=myRng2
    Set myRng1 = Nothing
    Set myRng2 = Nothing

TOP

ÄÀ©ñª«¥ó

Set myRng1 = Nothing'±NmyRng1 ª«¥óÄÀ©ñ
­Y¬O§Ú¦^µª¡A¨Ï±zº¡·N¡A½Ð±zÅý§Úª¾¹D¡I                  
­Y¬O§Úªº¦^ÂСA±z¤´¦³¨ä¥L¨£¸Ñ¡A¤]½Ð±z¤£¶Þ«ü±Ð¡I

TOP

thanks min

TOP

        ÀR«ä¦Û¦b : ¤Ñ¤W³Ì¬ü¬O¬P¬P¡A¤H¥Í³Ì¬ü¬O·Å±¡¡C
ªð¦^¦Cªí ¤W¤@¥DÃD