[發問] 請問統計特定條件不重複之數量如何改以VBA執行

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

18^#

發表於 2017-5-12 09:30 | 只看該作者

[版主管理留言]

GBKEE(2017/5/13 06:48): 請附欓看看

版大不好意思,
原本上方的程式碼是一次只計算一種人數,如果要統計8種不同條件的人數
就必須做8種程式

嘗試改成以下讓他依序一直統計下去
但在 FOR EACH這行會遇到陣列長度鎖定,不知怎麼把它做清除
查資料說進入迴圈後就會鎖住只能讀取無法寫入,

Sub 統計人數()
Dim A, xD, t$(1), n&(1), i
Set xD = CreateObject("Scripting.Dictionary")
For i = 3 To Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
t(0) = Mid(Range("B" & i), 1, 2)
t(1) = Mid(Range("B" & i), 3, 1)
For Each A In Range([工作表1!C2], [工作表1!C1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
If A = "0" Or xD(A) = 1 Then GoTo 101
If InStr(A, t(0)) Then
If InStr(A, t(1)) Then n(1) = n(1) + 1 Else n(0) = n(0) + 1
End If
xD(A) = 1
101: Next
Range("C" & i) = n(0)
Range("D" & i) = n(1)
Next
End Sub

複製代碼

回復 starry1314

...
准提部林發表於 2015-11-10 16:33

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

17^#

發表於 2016-2-22 09:17 | 只看該作者

回復 14# 准提部林

原本想說將總結果-1
但因不是每次都剛好有空白格,有時會皆有數據這樣跟實際又少1了
If A = "0" Or xD(A) = 1 Then GoTo 101

以解決不知這樣會有什麼錯誤嗎?

Sub test()
Dim A, xD, T$(1), N&(1)
Set xD = CreateObject("Scripting.Dictionary")
T(0) = Mid([配膳總表_早!C3], 1, 1)
T(1) = Mid([配膳總表_早!C3], 2, 1)
For Each A In Range([工作表1!C2], [工作表1!C1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
If A = "" Or xD(A) = 1 Then GoTo 101
If InStr(A, T(0)) Then
If InStr(A, T(1)) Then N(1) = N(1) + 1 Else N(0) = N(0) + 1
End If
xD(A) = 1
101: Next
[配膳總表_早!C5] = N(0)
[配膳總表_早!C6] = N(1)

複製代碼

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

16^#

發表於 2016-2-22 08:59 | 只看該作者

本帖最後由 starry1314 於 2016-2-22 09:00 編輯

回復 14# 准提部林

版大~不好意思
想請問以下如何讓他在執行過程中遇到空白列不+1呢?
例:有七個不同的編號他中間穿插了一個空白格
出來的數量會變為8(統計到空白格了)

Sub test()
原本想說將總結果-1
但因不是每次都剛好有空白格,有時會皆有數據這樣跟實際又少1了
Dim A, xD, T$(1), N&(1)
Set xD = CreateObject("Scripting.Dictionary")
T(0) = Mid([配膳總表_早!C3], 1, 1)
T(1) = Mid([配膳總表_早!C3], 2, 1)
For Each A In Range([工作表1!C2], [工作表1!C1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
If A = "" Or xD(A) = 1 Then GoTo 101
If InStr(A, T(0)) Then
If InStr(A, T(1)) Then N(1) = N(1) + 1 Else N(0) = N(0) + 1
End If
xD(A) = 1
101: Next
[配膳總表_早!C5] = N(0)
[配膳總表_早!C6] = N(1)

複製代碼

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

15^#

發表於 2015-11-10 16:58 | 只看該作者

回復 14# 准提部林
謝謝~數量已正常
沒資料顯示0是我把資料清空只留標題它會計算為1

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

14^#

發表於 2015-11-10 16:33 | 只看該作者

本帖最後由准提部林於 2015-11-10 16:45 編輯

回復 13# starry1314

那是累計不重覆個數!
沒資料顯示1? 什麼意思?改成以下:讓資料範圍多加二列空白列
For Each A In Range([工作表1!c2], [工作表1!c1].Cells(Rows.Count, 1).End(xlUp)(3)).Value

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

13^#

發表於 2015-11-10 15:16 | 只看該作者

回復 12# 准提部林
謝謝~可以使用！
想請問
Brr(k, Jm) = Brr(k, Jm) + 1　這段的＋１是？　
因如果無資料的話數量會顯示１

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

12^#

發表於 2015-11-10 13:06 | 只看該作者

回復 11# starry1314

Sub TEST()
Dim A, xD, Arr, Brr, j&, Jm&, k%
Set xD = CreateObject("Scripting.Dictionary")
Arr = [工作表2!A3:N3]
ReDim Brr(1 To 2, 1 To UBound(Arr, 2))
For Each A In Range([工作表1!c2], [工作表1!c1].Cells(Rows.Count, 1).End(xlUp)).Value
　　If A = "" Or xD(A) = 1 Then GoTo 101
　　Jm = 1
　　For j = 3 To UBound(Arr, 2) Step 2
　　　　If InStr(A, Arr(1, j)) Then Jm = j: Exit For
　　Next j
　　If InStr(A, "V") Then k = 2 Else k = 1
　　Brr(k, Jm) = Brr(k, Jm) + 1
　　xD(A) = 1
101: Next
[工作表2!A5:N6] = Brr
End Sub