starry1314

回復 9# 准提部林

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

准提部林

回復 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

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

准提部林

回復 13# starry1314


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

starry1314

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

starry1314

回復 14# 准提部林

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

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

複製代碼

starry1314

回復 14# 准提部林

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

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

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

複製代碼

starry1314

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

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

1. Sub 統計人數()
   
2. Dim A, xD, t$(1), n&(1), i
   
3. Set xD = CreateObject("Scripting.Dictionary")
   
4. 
   
5. For i = 3 To Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   
6. t(0) = Mid(Range("B" & i), 1, 2)
   
7. t(1) = Mid(Range("B" & i), 3, 1)
   
8. For Each A In Range([工作表1!C2], [工作表1!C1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
   
9. If A = "0" Or xD(A) = 1 Then GoTo 101
   
10.     If InStr(A, t(0)) Then
    
11.         If InStr(A, t(1)) Then n(1) = n(1) + 1 Else n(0) = n(0) + 1
    
12.     End If
    
13.     xD(A) = 1
    
14. 101: Next
    
15. Range("C" & i) = n(0)
    
16. Range("D" & i) = n(1)
    
17. 
    
18. Next
    
19. End Sub

複製代碼

回復  starry1314


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