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

標題: [發問] 請問統計特定條件不重複之數量如何改以VBA執行 [打印本頁]

作者: starry1314 時間: 2015-11-4 17:41 標題: 請問統計特定條件不重複之數量如何改以VBA執行

本帖最後由 starry1314 於 2015-11-4 17:55 編輯

=IFERROR(SUMPRODUCT(1/COUNTIF(rng早,rng早)*(MMULT(ISNUMBER(FIND(MID(A$3,{1,2},1),rng早))*1,{1;1})=2))-A6,"")
此串函數為統計 C欄內出現特定一樣條件之不重複數量

=IFERROR(SUMPRODUCT(1/COUNTIF(rng早,rng早)*(MMULT(ISNUMBER(FIND(MID(B$3,{1,2},1),rng早))*1,{1;1})=2)),"")
此串函數為統計 C欄內出現特定兩樣條件之不重複數量

rng早=資料範圍(定義名稱)

1.主要是統計C列不重複數量後,再從裡面判斷如[A3]的值為H  只計算編號內有出現H之數量後再扣除[A6]的數量
2.主要是統計C列不重複數量後,再從裡面判斷如[A3]的值為H  只計算編號內同時有出現H和V之數量

因資料眾多想請問如何改以陣列處理完後再輸出所要數量
[attach]22339[/attach]

[attach]22338[/attach]
[attach]22340[/attach]

作者: starry1314 時間: 2015-11-4 18:22

如何更改為不重複次數呢

Sub 統計特定條件個數()
Dim arr, n&, i&, j&, hh$
arr = Sheets("工作表1").Range("C2:C4000").Value
For i = 1 To 3999
For j = 1 To Len(arr(i, 1))
hh = Mid(arr(i, 1), j, 1)
If hh Like "[H]" Then n = n + 1
Next
Next
MsgBox n
End Sub

複製代碼

另要如何加入同時有出現H和V的數量

If hh Like "[H]" And hh Like "[V]" Then n = n + 1
統計出來是0

作者: starry1314 時間: 2015-11-4 18:50

請問如何改為統計不重複個數呢

Sub 統計條件重複個數()
Dim arr, n&, i&, j&, hh$
arr = Sheets("工作表1").Range("C2:C4000").Value
For i = 1 To 3999
For j = 1 To Len(arr(i, 1))
hh = Mid(arr(i, 1), j, 12)
If hh Like "*H*" And hh Like "*V*" Then n = n + 1
Next
Next
MsgBox n
End Sub

複製代碼

作者: 准提部林 時間: 2015-11-4 18:52

Sub TEST()
Dim A, xD, T$(1), N&(1)
Set xD = CreateObject("Scripting.Dictionary")
T(0) = Mid([工作表2!b3], 1, 1)
T(1) = Mid([工作表2!b3], 2, 1)
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
　　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
[工作表2!A5] = N(0)
[工作表2!A6] = N(1)
End Sub

作者: hcm19522 時間: 2015-11-4 19:32

A5{=COUNT(1/(FIND(A3,工作表1!C2:C24)*ISERR(FIND("V",工作表1!C2:C24))*(COUNTIF(OFFSET(工作表1!C2,,,ROW(C1:C23)),工作表1!C2:C24)=1)))
A6{=COUNT(1/(COUNTIF(OFFSET(工作表1!C2,,,ROW(C1:C23)),工作表1!C2:C24)=1)*FIND(A3,工作表1!C2:C24)*FIND("V",工作表1!C2:C24))

作者: starry1314 時間: 2015-11-4 23:31

回復 4# 准提部林

謝謝解決難題！！想破頭都搞不定

作者: starry1314 時間: 2015-11-4 23:32

回復 5# hcm19522

謝謝～因只想用ＶＢＡ
我提供的函數原本已可出現我要的效果～但資料太多　計算太緩慢了

作者: starry1314 時間: 2015-11-10 09:41

Sub TEST()
Dim A, xD, T$(1), N&(1)
Set xD = CreateObject("Scripting.Dictionary")
T(0) = Mid([工作表2!b3], 1, 1)
T(1) = Mid([工作表2!b3], 2, 1)
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
　　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
[工作表2!A5] = N(0)
[工作表2!A6] = N(1)
End Sub
准提部林發表於 2015-11-4 18:52

版大您好遇到個問題....如果抓出T(0)專屬單位的編號可以計算正確,
但因只有6個單位需單獨計算專屬的數量,可否只計算將6個單位以外的編號數量

作者: 准提部林 時間: 2015-11-10 09:49

回復 8# starry1314

請提出範例, 並模擬結果及說明規則~~

作者: starry1314 時間: 2015-11-10 10:09

回復 9# 准提部林

已附上~謝謝
[attach]22384[/attach]

[attach]22385[/attach]

作者: starry1314 時間: 2015-11-10 11:18

回復 9# 准提部林

或是可否統計不含V的不重複總數已及含V的不重複總數
扣掉其他列出的單位數量即可得出所要數量

作者: 准提部林 時間: 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

作者: starry1314 時間: 2015-11-10 15:16

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

作者: 准提部林 時間: 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

作者: starry1314 時間: 2015-11-10 16:58

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

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

複製代碼

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

複製代碼

作者: starry1314 時間: 2017-5-12 09:30

版大不好意思,
原本上方的程式碼是一次只計算一種人數,如果要統計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

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