麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 有條件的統計 [打印本頁]

作者: gctsai 時間: 2011-7-20 22:50 標題: 有條件的統計

請問各位大大:
我有一個工作表如下(SHEET1)
[attach]7071[/attach]
我需要統計A公司的品名及數量如下(SHEET2)
[attach]7073[/attach]
要如何做呢?

作者: chin15 時間: 2011-7-20 23:22

建議用樞鈕吧
[attach]7077[/attach]

作者: AnitaHuang99 時間: 2011-7-21 10:15

如果只是要得到各別小計數, 建議可以試試用sumproduct把公司, 月份, 品名的條件放進去

作者: gctsai 時間: 2011-7-21 20:30

謝謝chin15大大
我現在是用樞紐,但是存檔後檔案變的很大
所以我想如果用vba會不會檔案變的比較小
還有如果有兩個以上的條件呢
如 "A" 公司在 "1" 月份的品名數量呢?
PS.因為同樣的檔案有很多所以如果用VBA後再做個按鈕就可以使用很多個檔案了(不用每個檔案都做樞紐).

作者: GBKEE 時間: 2011-7-22 07:34

本帖最後由 GBKEE 於 2011-7-22 07:37 編輯

回復 4# gctsai
先學基本功 3樓提議的工作表函數SUMPRODUCT
圖一 SHEET1 (資料區)
[attach]7108[/attach]
圖二 SHEET2
[attach]7109[/attach]
數量的公式
B5=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A5))
B6=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A6))
B7=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A7))
B8=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A8))

作者: gctsai 時間: 2011-7-24 20:00

謝謝GBKEE大大
1.因為只知道公司及月份而品名的名稱及種類無法知道(如可能會有增加鳳梨,龍眼之類的)
2.因為我目前有50個類似的檔案,不想一個個檔案去做,所以才想說用vba的

作者: GBKEE 時間: 2011-7-24 20:43

回復 6# gctsai
VBA程序是要量身套製的,所以附黨上來規定條件要放那裡說明白, 回答才會明確.

作者: gctsai 時間: 2011-7-26 16:02

1.大大我的問題是要如何用vba做(如附檔)
2.要如何從來源的工作頁中統計出"三洋"公司的序號出現的次數
3.其中條件"三洋"是不用顯示的
4.因為有很多檔案如果用樞紐分析的話要每一個檔案都做,重點是檔案會變很大
[attach]7138[/attach]

作者: GBKEE 時間: 2011-7-27 08:28

回復 8# gctsai
試試看

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

複製代碼

作者: gctsai 時間: 2011-7-27 20:37

謝謝GBKEE大大
已經可以用了,而且還可以直接把條件(如"三洋")打在vba內

作者: gctsai 時間: 2011-7-28 22:55

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

作者: GBKEE 時間: 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

複製代碼

作者: gctsai 時間: 2011-7-29 22:44

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

作者: chin15 時間: 2011-7-29 23:22

改用Worksheet_Calculate事件試試

作者: Hsieh 時間: 2011-7-29 23:49

回復 13# gctsai

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

作者: gctsai 時間: 2011-7-30 08:14

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

作者: GBKEE 時間: 2011-7-30 10:11

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

[attach]7184[/attach]

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

複製代碼

作者: gctsai 時間: 2011-7-30 22:27

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

作者: oobird 時間: 2011-7-30 23:30

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

作者: gctsai 時間: 2011-7-31 08:40

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

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

作者: oobird 時間: 2011-7-31 09:02

你把Private Sub Ex()
前面的Private 拿掉
就可在工作列~巨集內看到它
建立巨集時對話方塊存放位置就選"個人巨集活頁簿"
這樣開每個檔案都會隨之開啟
存增益集是另存，選"xla",存好後在增益集中載入

作者: gctsai 時間: 2011-7-31 11:07

本帖最後由 gctsai 於 2011-7-31 11:15 編輯

你把Private Sub Ex()
前面的Private 拿掉
就可在工作列~巨集內看到它
建立巨集時對話方塊存放位置就選" ...
oobird 發表於 2011-7-31 09:02

謝謝大大,可是如果把"前面的Private 拿掉"的話那還可以自動更新嗎?
[attach]7224[/attach]
增益集不知道要選那一個??

作者: oobird 時間: 2011-7-31 11:18

Private表示 Sub 程序只在宣告它之模組裏的程序所使用。
與自動更新毫無關係。

作者: gctsai 時間: 2011-8-1 22:47

大大請問一下為什麼把"條件"從[A2]移到[C2],結果序號[E2]就變成了商品品名[G2]
[attach]7240[/attach]

作者: GBKEE 時間: 2011-8-2 17:39

回復 24# gctsai
程序裡請加上紅字部分
f = Application.Match(.[b1].Text, Sheets("來源").Rows(1), 0) 'f: 在來源中尋找統計的欄位
f = f - 2 '你A欄從移到C欄 ***** Rng.Offset會改變
If Rng = .Range("A2") Then D(Rng.Offset(, f- 1).Value) = D(Rng.Offset(, f - 1).Value) + 1

作者: gctsai 時間: 2011-8-2 20:37

回復 25# GBKEE

從 A欄移到C欄要加 f=f-2
那從A欄移到E欄是不是要加 F=F-4
也就是如果移多少欄就要減回來嗎??

作者: sonynetmd 時間: 2011-8-3 10:01

請問各位大大, 如果計算"數量"可否不是利用等於號(=) 絕對值 {0,1,2...}, 而改為大於/小於可以嗎?
小學生 sony

作者: GBKEE 時間: 2011-8-3 15:05

回復 26# gctsai
修改如下就必去計算欄位了

Sub Ex()
Dim D As Object, Rng As Range, f As Variant
Set D = CreateObject("SCRIPTING.DICTIONARY") '設立字典物件
With Sheets("來源")
Set Rng = .[c2] '設立儲存格物件
f = Application.Match(Sheets("統計").[b1].Text, .Rows(1), 0) 'f: 在來源中尋找統計的欄位
If IsError(f) Then MsgBox "統計的欄位不存在!!!": Exit Sub
Do While Rng <> "" 'Rng的值為空白時不執行 Do的迴圈
If Rng = Sheets("統計").Range("A2") Then D(.Cells(Rng.Row, f).Value) = D(.Cells(Rng.Row, f).Value) + 1
' .[A2] ->Sheets("統計")[A2] '字典物件(KEY)=ITEM + 1
Set Rng = Rng.Offset(1) 'Rng下移一列位
Loop
End With
With Sheets("統計").[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
Set D = Nothing
Set Rng = Nothing
End Sub

複製代碼

作者: am0251 時間: 2011-8-3 16:35

不好意思,GBKEE大大,可以解釋一下"SCRIPTING.DICTIONARY"的用法呢?這個我還沒學過,謝謝!

作者: oobird 時間: 2011-8-3 16:52

回復 29# am0251

http://forum.twbts.com/thread-20-1-1.html

作者: gctsai 時間: 2011-8-4 21:36

謝謝各位大大的指導,終於完善了

作者: wsx24680 時間: 2011-8-12 10:45

D(Rng.Offset(, 1).Value) = D(Rng.Offset(, 1).Value) + 1

沒想到還能這樣用
又學到了，感謝

作者: h60327 時間: 2011-8-19 19:52

gbkee版主解釋的好清楚
又學會了新觀念

作者: Andy2483 時間: 2023-3-31 16:18

本帖最後由 Andy2483 於 2023-3-31 16:23 編輯

回復 24# gctsai

謝謝論壇,謝謝前輩發表此主題與範例檔
後學藉此帖研究資料表排序後才帶入陣列,資料表復原,接著才進行統計,
學習到很多知識,學習方案如下,請各位前輩指教

來源表:
[attach]36077[/attach]

統計表:結果
[attach]36078[/attach]

Option Explicit
Sub 宣告()
Dim Brr, Crr, Y, N&, C&, R&, i&, j&, T$, T2$, T3$, TT$
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("來源"): Set Sh2 = Sheets("統計")
C = Sh1.UsedRange.Columns.Count: R = Sh1.UsedRange.Rows.Count
With Range(Sh1.[A1], Sh1.Cells(R, C + 1))
With .Columns(C + 1): .Value = "=ROW(A1)": .Value = .Value: End With
.Sort KEY1:=.Item(3), Order1:=1, Key2:=.Item(2), Order2:=1, Header:=1
Brr = .Value
.Sort KEY1:=.Item(C + 1), Order1:=1, Header:=1: .Columns(C + 1).Delete
End With
For i = 2 To UBound(Brr)
T = Brr(i, 3): If Y(T) = "" Then Y(T) = Y.Count: Y(T & "|儲位數") = ""
Next
Sh2.UsedRange.Delete
With Sh2.[A1].Resize(1, Y.Count)
.Value = Y.keys: .Replace "*|", "", Lookat:=xlPart
End With
ReDim Crr(1 To R, 1 To Y.Count)
For i = 2 To UBound(Brr)
T2 = Brr(i, 2): T3 = Brr(i, 3): TT = T3 & "|" & T2
If Y(TT) = "" Then
   Y(T3 & "/r") = Y(T3 & "/r") + 1
   Crr(Y(T3 & "/r"), Y(T3)) = T2
   Crr(Y(T3 & "/r"), Y(T3) + 1) = 1
   Y(TT) = 1
   Else
      N = Y(T3 & "/r")
      Crr(N, Y(T3) + 1) = Crr(N, Y(T3) + 1) + 1
End If
Next
With Sh2.[A2].Resize(UBound(Crr), UBound(Crr, 2))
.Value = Crr: .EntireColumn.AutoFit
End With
Set Y = Nothing: Erase Brr, Crr: Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

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