b9208

帖子: 182
主題: 34
精華: 0
積分: 316
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-5-2
最後登錄: 2023-6-24

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2020-8-20 16:13 | 只看該作者

[發問] 多條件統計

您好！
請問多條件統計次數
由「資料」工作表統計每日（B欄）各人口（H欄）使用次數，並輸出於「工作表2」。
謝謝

W1.zip (19.49 KB)

樓主熱帖

100 字節以內
不支持自定義 Discuz! 代碼

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

2^#

發表於 2020-8-21 08:20 | 只看該作者

回復 1# b9208

C7=COUNTIFS(資料!$B:$B,工作表2!$B$7,資料!$H:$H,工作表2!C6)右拉
C8=COUNTIFS(資料!$B:$B,工作表2!$B$8,資料!$H:$H,工作表2!C6)右拉

TOP

b9208

中學生 Rank: 2

帖子: 182
主題: 34
精華: 0
積分: 316
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-5-2
最後登錄: 2023-6-24

3^#

發表於 2020-8-21 09:43 | 只看該作者

回復 2# jcchiang
非常感謝指導
但需統計至少一年以上資料，如用EXCEL函數方法，運算時間太久。
所以請教利用VBA方式運算

100 字節以內
不支持自定義 Discuz! 代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

4^#

發表於 2020-8-21 10:09 | 只看該作者

第6行的 N1~N4, S1~S5 是固定不變的???

TOP

b9208

中學生 Rank: 2

帖子: 182
主題: 34
精華: 0
積分: 316
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-5-2
最後登錄: 2023-6-24

5^#

發表於 2020-8-21 11:12 | 只看該作者

回復 4# 准提部林
固定不變
謝謝

100 字節以內
不支持自定義 Discuz! 代碼

TOP

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

6^#

發表於 2020-8-21 11:26 | 只看該作者

回復 3# b9208

試試看
Sub ex()
Dim arr
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = Sheets("資料").[B5].CurrentRegion
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, 2) & arr(i, 8)) Then
   d.Add (arr(i, 2) & arr(i, 8)), 1
Else
   d(arr(i, 2) & arr(i, 8)) = d(arr(i, 2) & arr(i, 8)) + 1
End If
Next
With Sheets(1)
arr = .[B6].CurrentRegion
For i = 2 To UBound(arr, 2) - 1
For j = 2 To UBound(arr)
   If d(arr(j, 1) & arr(1, i)) = "" Then
      arr(j, i) = 0
   Else
      arr(j, i) = d(arr(j, 1) & arr(1, i))
   End If
Next
Next
.[B6].CurrentRegion = arr
.[L7].Resize(UBound(arr) - 1) = "=sum(c7:K7)"
.[L:L] = .[L:L].Value
End With
Set d = Nothing
End Sub

TOP

b9208

中學生 Rank: 2

帖子: 182
主題: 34
精華: 0
積分: 316
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-5-2
最後登錄: 2023-6-24

7^#

發表於 2020-8-21 12:31 | 只看該作者

回復 6# jcchiang
非常感謝協助與指導
程式執行OK
但「工作表2」之日期，是依據「資料」內日期輸出不重復日期，並非事先輸入的。

100 字節以內
不支持自定義 Discuz! 代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

8^#

發表於 2020-8-21 12:48 | 只看該作者

Sub TEST()
Dim Arr, Brr, xD, i&, j%, K, R&, C&, N&
Set xD = CreateObject("Scripting.Dictionary")
[工作表2!B7:B2000].EntireRow.Delete
Arr = [工作表2!B6:K6]
For j = 2 To UBound(Arr, 2): xD(Arr(1, j)) = j: Next
Arr = Range([資料!A1], Sheets("資料").UsedRange)
ReDim Brr(1 To UBound(Arr), 1 To 11)
For i = 5 To UBound(Arr)
K = Arr(i, 2): R = Val(xD(K)): C = Val(xD(Arr(i, 8)))
If K = "" Or C = 0 Then GoTo 101
If R = 0 Then N = N + 1: R = N: xD(K) = N: Brr(N, 1) = K
Brr(R, C) = Brr(R, C) + 1: Brr(R, 11) = Brr(R, 11) + 1
101: Next i
With [工作表2!B7].Resize(N, 11)
.Value = Brr
.Borders.LineStyle = 1
End With
End Sub