有條件的統計 - Excel程式區 - 麻辣家族討論版版

gctsai

等待驗證會員

帖子: 42
主題: 10
精華: 0
積分: 72
點名: 0
作業系統: WIN
軟體版本: XP
閱讀權限: 0
註冊時間: 2010-12-12
最後登錄: 2019-6-8

11^# 跳轉到 »

發表於 2011-7-28 22:55 | 只看該作者

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

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

12^#

發表於 2011-7-29 06:32 | 只看該作者

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

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

複製代碼

TOP

gctsai

等待驗證會員

帖子: 42
主題: 10
精華: 0
積分: 72
點名: 0
作業系統: WIN
軟體版本: XP
閱讀權限: 0
註冊時間: 2010-12-12
最後登錄: 2019-6-8

13^#

發表於 2011-7-29 22:44 | 只看該作者

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

TOP

chin15

中學生 Rank: 2

帖子: 227
主題: 3
精華: 1
積分: 273
點名: 0
作業系統: XP
軟體版本: XP
閱讀權限: 20
性別: 女
註冊時間: 2011-3-22
最後登錄: 2013-1-29

14^#

發表於 2011-7-29 23:22 | 只看該作者

改用Worksheet_Calculate事件試試

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

15^#

發表於 2011-7-29 23:49 | 只看該作者

回復 13# gctsai

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

學海無涯_不恥下問

TOP

gctsai

等待驗證會員

帖子: 42
主題: 10
精華: 0
積分: 72
點名: 0
作業系統: WIN
軟體版本: XP
閱讀權限: 0
註冊時間: 2010-12-12
最後登錄: 2019-6-8

16^#

發表於 2011-7-30 08:14 | 只看該作者

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

text.rar (13.72 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

17^#

發表於 2011-7-30 10:11 | 只看該作者

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

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