Board logo

標題: [發問] 統計筆數及計算數量 [打印本頁]
作者: b9208    時間: 2013-4-18 10:10     標題: 統計筆數及計算數量

前輩您好
如附檔內說明「統計筆數」及「計算數量」
「統計筆數」：條件欄位相同者，只算一筆資料。
「計算數量」：條件欄位相同者，只計算數量值〞最大值〞。
非常感謝指導

[attach]14694[/attach]
作者: b9208    時間: 2013-4-24 06:39

「統計筆數」：條件欄位相同者，只算一筆資料。
「計算數量」：條件欄位相同者，只加總數量值〞最大值〞。
懇請先進們指導
感激不盡
作者: ML089    時間: 2013-4-24 11:13

本帖最後由 Hsieh 於 2013-4-24 22:47 編輯

先給 O8 公式
=COUNT(MATCH(ROW($8:$24)-7,MATCH($N8&$C$8:$C$24&O$7,TEXT($B$8:$B$24,"ddd")&$C$8:$C$24&$D$8:$D$24,),))
陣列公式(先按CTRL、SHIFT不放，再按ENTER三鍵齊按輸入)

O19公式比較複雜要想一下，等晚上再研究
作者: ML089    時間: 2013-4-24 11:17

[attach]14768[/attach]

發帖後，公式裡面怎會有這些表情符號，要如何清除?
作者: Hsieh    時間: 2013-4-24 22:47

回復 4# ML089

發文時，勾選下方禁用表情選項
作者: Hsieh    時間: 2013-4-24 23:38

回復 1# b9208
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. For Each a In Range([B8], [B8].End(xlDown))
  5. m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
  6. n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
  7.    If d(m) <= a.Offset(, 7) Then _
  8.    d(m) = a.Offset(, 7)
  9.    d1(n) = ""
  10. Next
  11. For Each ky In d.keys
  12.   ar = Split(ky, ",")
  13.   d(ar(0) & ar(1)) = d(ar(0) & ar(1)) + d(ky)
  14. Next
  15. For Each ky In d1.keys
  16.   ar = Split(ky, ",")
  17.   d1(ar(0) & ar(2)) = d1(ar(0) & ar(2)) + 1
  18. Next
  19. For Each a In [N8:N14]
  20.    For Each c In [O7:P7]
  21.      Cells(a.Row, c.Column) = IIf(d1(a & c) = "", 0, d1(a & c))
  22.    Next
  23. Next
  24. For Each a In [N19:N25]
  25.    For Each c In [O7:P7]
  26.      Cells(a.Row, c.Column) = IIf(d(a & c) = "", 0, d(a & c))
  27.    Next
  28. Next
  29. End Sub
複製代碼
作者: ML089    時間: 2013-4-25 09:32

本帖最後由 Hsieh 於 2013-4-25 10:05 編輯

O19公式
=SUM(IF(FREQUENCY(IF($N19&O$18=TEXT($B$8:$B$24,"ddd")&$D$8:$D$24,MATCH(TEXT($B$8:$B$24,"ddd")&$D$8:$D$24&$F$8:$F$24,TEXT($B$8:$B$24,"ddd")&$D$8:$D$24&$F$8:$F$24,),""),ROW($8:$24)-7), SUBTOTAL(4,OFFSET($I$7,ROW($8:$25)-7,,FREQUENCY(IF($N19&O$18=TEXT($B$8:$B$24,"ddd")&$D$8:$D$24,MATCH(TEXT($B$8:$B$24,"ddd")&$D$8:$D$24&$F$8:$F$24,TEXT($B$8:$B$24,"ddd")&$D$8:$D$24&$F$8:$F$24,),""),ROW($8:$24)-7))),0))
三鍵輸入

實用還是以6樓超版的VBA好用

公式還是有些限制，如同類需排序在一起才能統計
資料以日期排序往下，"星期" 就會變成循環，星期+組別+人員 可能就會被分開，
因此使用公式時需將同類 "星期" 排序才能正確。
作者: ML089    時間: 2013-4-25 09:36

回復 6# Hsieh

超版:
如有空可否提供O8的VBA，這樣此題VBA及公式就雙齊全。
作者: ML089    時間: 2013-4-25 09:44

本帖最後由 ML089 於 2013-4-25 09:45 編輯

回復 5# Hsieh

在他人意見下方按回覆時，下方有 "禁用表情選項" 而且內定為勾選

若是自行回答  按下方的 發表回覆，下方沒有 "禁用表情選項"

這些表情隔天又會不見

滿困擾的
作者: Hsieh    時間: 2013-4-25 10:04

回復 9# ML089

隔天表情符號消失，是因為我幫你編輯過了
作者: b9208    時間: 2013-4-25 10:34

回復 6# Hsieh
Dear Hsieh
非常感謝幫忙與指導
目前運行上是ok的
謝謝
作者: b9208    時間: 2013-4-25 10:38

回復 7# ML089
Dear ML089

謝謝參與指導與討論，可以學習使用函數組合運用。
超版的vba可以統計筆數及數量。
作者: b9208    時間: 2013-4-26 13:10

回復 6# Hsieh
Dear Hsieh

For Each a In Range([B8], [B8].End(xlDown))
m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
   If d(m) <= a.Offset(, 7) Then d(m) = a.Offset(, 7)
   d1(n) = ""
Next
  
上句中 d1(n) = ""   之用意為何？
感謝指導
作者: b9208    時間: 2013-4-26 22:43

回復 6# Hsieh
Dear Hsieh
程式及輸出資料在同一工作表，執行OK。
如果程式及輸出表格置於sheet2，基本資料置於sheet1，輸出資料都是0。修訂如下：
With Sheets("sheet1")
For Each a In Range([B8], [B8].End(xlDown))
..........
.........................
End With
For Each a In [N8:N14]

另請教增加直接計算加總 Total 功能，如何修改。謝謝
作者: Hsieh    時間: 2013-4-27 23:20

回復 14# b9208
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. With Sheets("Sheet1")
  5. For Each a In .Range(.[B8], .[B8].End(xlDown))
  6. m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
  7. n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
  8.    If d(m) <= a.Offset(, 7) Then _
  9.    d(m) = a.Offset(, 7) '取出B、D、F欄同組最大值
  10.    d1(n) = "" 'B、C、D欄不重複索引
  11. Next
  12. End With
  13. For Each ky In d.keys
  14.   ar = Split(ky, ",")
  15.   d(ar(0) & ar(1)) = d(ar(0) & ar(1)) + d(ky) '取出B、D、F欄同組加總
  16. Next
  17. For Each ky In d1.keys
  18.   ar = Split(ky, ",")
  19.   d1(ar(0) & ar(2)) = d1(ar(0) & ar(2)) + 1 ''B、C、D欄組合計數
  20. Next
  21. With Sheets("Sheet2")
  22. For Each c In .[O7:P7]
  23. cnt = 0
  24.    For Each a In .[N8:N14]
  25.     .Cells(a.Row, c.Column) = IIf(d1(a & c) = "", 0, d1(a & c))  '依序填入組合計數
  26.      cnt = cnt + d1(a & c)
  27.    Next
  28. .Cells(15, c.Column) = cnt
  29. Next
  30. For Each c In .[O7:P7]
  31. cnt = 0
  32.     For Each a In .[N19:N25]
  33.      .Cells(a.Row, c.Column) = IIf(d(a & c) = "", 0, d(a & c)) '依序填入組合加總
  34.      cnt = cnt + d1(a & c)
  35.    Next
  36. .Cells(26, c.Column) = cnt
  37. Next
  38. End With
  39. End Sub
複製代碼
[attach]14803[/attach]
作者: b9208    時間: 2013-4-30 20:05

回復 15# Hsieh
謝謝版主
可以執行
符合需求
作者: freeffly    時間: 2013-5-9 16:41

回復 15# Hsieh


    一行一行看能大略能解讀
   不過要自己寫出來有點難
   學習了
作者: b9208    時間: 2013-5-9 20:19

回復 15# Hsieh
Dear Hsieh

For Each a In .Range(.[B8], .[B8].End(xlDown))
m = a.Text & "," & a.Offset(, 2) & "," & a.Offset(, 4)
n = a.Text & "," & a.Offset(, 1) & "," & a.Offset(, 2)
   If d(m) <= a.Offset(, 7) Then _
   d(m) = a.Offset(, 7) '取出B、D、F欄同組最大值
   d1(n) = "" 'B、C、D欄不重複索引
Next
上述程式中   d1(n) = "" 'B、C、D欄不重複索引
思考很久了還是無法理解
d1(n) 設定成""，後續如何計數？
懇請指導
作者: Hsieh    時間: 2013-5-9 20:29

回復 18# b9208
在此階段的字典作用，主要是取得項目
先知道同組的索引有哪些?
後面
For Each ky In d1.keys
  ar = Split(ky, ",")
  d1(ar(0) & ar(2)) = d1(ar(0) & ar(2)) + 1 ''B、C、D欄組合計數
Next
這段就是讓B、D欄相同者計數
作者: Andy2483    時間: 2024-1-24 08:54

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
[attach]37343[/attach]

執行結果:
[attach]37344[/attach]

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr(8, 100), A%, Z, B%, V%, i&, C%, T2$, T3$, T4$, T6$, T9$
ActiveSheet.UsedRange.EntireColumn.Offset(, 17).Delete
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([I7], [A65536].End(3))
Crr(0, 0) = Brr(1, 2) & " \ " & Brr(1, 4)
For i = 2 To 8: Crr(i - 1, 0) = Format(i, "DDD"): Z(Crr(i - 1, 0)) = i - 1: Next
Crr(8, 0) = "TOTAL": Arr = Crr
For i = 2 To UBound(Brr)
   T2 = Format(Brr(i, 1), "DDD"): T4 = Brr(i, 4): T6 = Brr(i, 6): T3 = Brr(i, 3): T9 = Brr(i, 9)
   A = Z(T2): B = Z(T4): V = Z(T2 & T6 & T4)
   If B = 0 Then C = C + 1: B = C: Z(Brr(i, 4)) = B: Arr(0, C) = Brr(i, 4): Crr(0, C) = Brr(i, 4)
   If Z(T2 & T3 & T4) = 0 Then Z(T2 & T3 & T4) = 1: Crr(A, B) = Crr(A, B) + 1
   If V = 0 Then V = Val(T9): Z(T2 & T6 & T4) = V: Arr(A, B) = Arr(A, B) + V: GoTo i01
   If Z(T2 & T6 & T4) < Val(T9) Then
      Arr(A, B) = Arr(A, B) - Z(T2 & T6 & T4) + Val(T9): Z(T2 & T6 & T4) = Val(T9)
   End If
i01: Next
[R6] = "統計組別筆數"
With [R7].Resize(9, C + 1)
   .Value = Crr: .SpecialCells(4) = 0: .Borders.LineStyle = 1: .EntireColumn.HorizontalAlignment = xlCenter
   .Offset(, 1).Sort KEY1:=.Item(1), Order1:=1, Header:=1, Orientation:=2
   .Item(9, 2).Resize(, C) = "=SUM(" & Intersect(.Columns(2), [8:14]).Address(0, 0) & ")"
End With
[R17] = "計算數量"
With [R18].Resize(9, C + 1)
   .Value = Arr: .SpecialCells(4) = 0: .Borders.LineStyle = 1: .Columns(1).EntireColumn.AutoFit
   .Offset(, 1).Sort KEY1:=.Item(1), Order1:=1, Header:=1, Orientation:=2
   .Item(9, 2).Resize(, C) = "=SUM(" & Intersect(.Columns(2), [19:25]).Address(0, 0) & ")"
End With
End Sub
作者: hcm19522    時間: 2024-1-24 14:01

(輸入編號12330) google網址:https://draft.blogger.com/blog/posts/9094075214774179359



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