gctsai

大大另外如果我想要在資料有變更或增加時自動更新結果呢?

GBKEE

回復 11# gctsai
使用工作表的預設事件Worksheet_Change,這是你附件Sheets("來源")的程式碼.

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Ex
   
3. End Sub
   
4. Private Sub Ex()
   
5.     Dim D As Object, Rng As Range
   
6.     Set D = CreateObject("SCRIPTING.DICTIONARY") '設立字典物件
   
7.     Set Rng = Sheets("來源").[A2]                                       '設立儲存格物件
   
8.     With Sheets("統計")
   
9.         Do While Rng <> ""        'Rng的值為空白時不執行 Do的迴圈
   
10.             If Rng = .[A2] Then D(Rng.Offset(, 1).Value) = D(Rng.Offset(, 1).Value) + 1
    
11.             '        .[A2] ->Sheets("統計")[A2]      '字典物件(KEY)=ITEM + 1
    
12.             Set Rng = Rng.Offset(1)  'Rng下移一列位
    
13.         Loop
    
14.         With .[B2:C2]
    
15.             .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
16.             .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
17.             .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
18.         End With
    
19.     End With
    
20.     Set D = Nothing
    
21.     Set Rng = Nothing
    
22. End Sub

複製代碼

gctsai

大大我在"來源"增加了一列資料如下
  A                B                   C
三洋        D25-MOTO        NOKIA
可是"統計"也沒有自動再計算一次,而是要在執行一次巨集後才會從新計算

chin15

改用Worksheet_Calculate事件試試

Hsieh

回復 13# gctsai

我想你是程式碼放錯模組吧!
注意GBKEE提示該程式碼必須置放在來源工作表模組內

gctsai

謝謝大大的指導,已經可以用了,原來是模組的問題
那如果要統計的欄位不在旁邊呢
If Rng = "三洋" Then D(Rng.Offset(, 3).Value) = D(Rng.Offset(, 3).Value) + 1
除了上述之外是否可以有另外的方式因為有時候要統計的欄位會離的很遠甚至會在條件的前面
text.rar (13.72 KB)

下載次數: 16

2011-7-30 08:14

GBKEE

回復 16# gctsai
那如果要統計的欄位不在旁邊呢
那你要跟電腦說阿 如圖

   

下載 (29.07 KB)

2011-7-30 10:10

1. Private Sub Ex()
   
2.     Dim D As Object, Rng As Range, f As Variant
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY") '設立字典物件
   
4.     Set Rng = Sheets("來源").[a2]    '設立儲存格物件
   
5.     With Sheets("統計")
   
6.          f = Application.Match(.[b1].Text, Sheets("來源").Rows(1), 0) 'f: 在來源中尋找統計的欄位
   
7.          If IsError(f) Then MsgBox "統計的欄位不存在!!!": Exit Sub
   
8.         Do While Rng <> ""        'Rng的值為空白時不執行 Do的迴圈
   
9.             If Rng = .Range("A2") Then D(Rng.Offset(, f - 1).Value) = D(Rng.Offset(, f - 1).Value) + 1
   
10.             '        .[A2] ->Sheets("統計")[A2]      '字典物件(KEY)=ITEM + 1
    
11.             Set Rng = Rng.Offset(1)  'Rng下移一列位
    
12.         Loop
    
13.         With .[B2:C2]
    
14.             .Resize(.CurrentRegion.Rows.Count, 2) = ""
    
15.             .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
16.             .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
17.             .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
18.         End With
    
19.     End With
    
20.     Set D = Nothing
    
21.     Set Rng = Nothing
    
22. End Sub

複製代碼

gctsai

謝謝大大,我已經有跟電腦說了,它說ok!
但是問題寶寶又有一個問題,就是:
如果有別的檔案也是要用這個vba,可是我在巨集內找不到

下載 (26.36 KB)

2011-7-30 22:26

oobird

常用到的話可把巨集存放在個人巨集活頁簿
也可做成增益集載入

gctsai

常用到的話可把巨集存放在個人巨集活頁簿
也可做成增益集載入
oobird 發表於 2011-7-30 23:30

請問大大巨集活頁簿或增益集要如何做呢?