Board logo

標題: [發問] VBA counta [打印本頁]
作者: john2006168    時間: 2010-5-15 01:06     標題: VBA counta

本帖最後由 Hsieh 於 2010-5-15 10:00 編輯

我有一組數字如Sheet1 A,想Delete 右邊最後4個字 之後再counta 每個字有幾多個是重複.

請問用VBA怎麼寫

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
作者: Min    時間: 2010-5-15 09:41

呵呵呵~ 我只會用迴圈算...
作者: Hsieh    時間: 2010-5-15 09:54

本帖最後由 Hsieh 於 2010-5-15 10:04 編輯
  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
複製代碼
[attach]434[/attach]
作者: GBKEE    時間: 2010-5-15 20:07

  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
複製代碼
作者: john2006168    時間: 2010-5-15 23:51

本帖最後由 Hsieh 於 2010-5-16 21:57 編輯

多謝兩位老師的指教,不過我會用hsieh的寫法,好像易懂些.
另外,我有時看一些寫法,喜歡在最後加上 以下2句...想問一下到底有什麼作用??
   Set myRng1 = Nothing
    Set myRng2 = Nothing

------------
因為要在A 加些item no,所以......我的寫法
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
作者: Min    時間: 2010-5-16 19:53

釋放物件

Set myRng1 = Nothing'將myRng1 物件釋放
作者: john2006168    時間: 2010-5-19 23:38

thanks min



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)