查找號碼。時間價值與其他組合發生

Question

我有一個列包含部門和另一列包含應用程序，可以，不顯示。我想計算每個部門爲Appt，Can和No Show發生多少次。我目前使用的代碼提取部門的唯一值，並使用If語句計算Appt，Can和No Show的值。

數據集： http://bit.ly/1HkvAxR 代碼來獲得獨特部門：

Public Sub Getting_Unique_Departments() 
Dim X 
Dim objDict As Object 
Dim lngRow As Long 
If Len("E") > 0 And Len("Y") > 0 Then 
Set objDict = CreateObject("Scripting.Dictionary") 
X = Application.Transpose(Range("E" & 2, Cells(Rows.Count, "E").End(xlUp))) 
For lngRow = 1 To UBound(X, 1) 
    objDict(X(lngRow)) = 1 
Next 
Range("Y" & 2 & ":" & "Y" & objDict.Count + 1) = Application.Transpose(objDict.keys) 
End If 

End Sub 

代碼檢查聘任，可以，走路，沒有顯示各個部門。

Sub Calculation() 
nName0 = "Department" 
nName1 = "Appt" 
nName2 = "Walk" 
nName3 = "Can" 
nName4 = "No Show" 


Cells(1, 25).Value = nName0 
Cells(1, 26).Value = nName1 
Cells(1, 27).Value = nName2 
Cells(1, 28).Value = nName3 
Cells(1, 29).Value = nName4 
For Dept_Row_number = 2 To Dept_lastRow 

'Dept_lastRow finds last Row of unique department listed in Y col and Sheet_lastRow finds the last Row of input data sheet. 
nCount1 = 0 
nCount1 = 0 
nCount2 = 0 
nCount3 = 0 
nCount4 = 0 

Row_number = 1 

search_string1 = ActiveSheet.Cells(Dept_Row_number, 25) 


Do 
DoEvents 

Row_number = Row_number + 1 

item_in_review1 = ActiveSheet.Cells(Row_number, 5).Value 
item_in_review2 = ActiveSheet.Cells(Row_number, 3).Value 



If InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "Appt") > 0 Then 
     nCount1 = nCount1 + 1 


ElseIf InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "Walk") > 0 Then 
     nCount2 = nCount2 + 1 

ElseIf InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "Can") > 0 Then 
     nCount3 = nCount3 + 1 

ElseIf InStr(item_in_review1, search_string1) > 0 And InStr(item_in_review2, "No Show") > 0 Then 
     nCount4 = nCount4 + 1 
End If 

Loop Until Row_number = Sheet_lastRow 



Cells(Dept_Row_number, 26).Value = nCount1 
Cells(Dept_Row_number, 27).Value = nCount2 
Cells(Dept_Row_number, 28).Value = nCount3 
Cells(Dept_Row_number, 29).Value = nCount4 
Next 

是否有任何簡單的方法來解決這個問題，因爲萬一我必須爲多個列執行此操作時，代碼會太麻煩。

Answer 1

拜倫牆是正確的，樞軸表是一個自然的選擇 - 但你也可以簡化VBA。你知道字典，但可能會更多地利用它們。我建議使用早期綁定 - 在工具/參考中添加對Microsoft腳本運行時間的引用，然後您可以按照以下幾行編寫代碼。主循環填充鍵入部門的字典。這本字典的價值是它們自己的字典（「不顯示」等）鍵入的字典。 這些字典的值是您之後的計數。在代碼的最後，我展示瞭如何你可以從這個數據結構中提取數據：

Function MakeCountDict(categories As Variant) As Dictionary 
    Dim d As New Dictionary 
    Dim i As Long 
    For i = LBound(categories) To UBound(categories) 
     d.Add categories(i), 0 
    Next i 
    Set MakeCountDict = d 
End Function 

Sub MakeDepartmentCounts() 
    Dim Dcounts As New Dictionary 
    Dim R As Range 
    Dim dept As Variant, cat As String 
    Dim categories As Variant 
    Dim i As Long, n As Long 
    Dim report As String 

    categories = Array("No Show", "Appt", "Can", "walk") 

    n = Range("H:H").Rows.Count 
    n = Range("H" & n).End(xlUp).Row 'last used row in column H 
    For i = 2 To n 
     dept = Trim(Cells(i, "H").Value) 
     If Not Dcounts.Exists(dept) Then 
      Dcounts.Add dept, MakeCountDict(categories) 
     End If 
     cat = Trim(Cells(i, "C").Value) 
     Dcounts(dept)(cat) = Dcounts(dept)(cat) + 1 
    Next i 

    report = "Report:" 

    For Each dept In Dcounts.Keys 
     report = report & vbCrLf & dept & ": " 
     For i = 0 To 3 
      cat = categories(i) 
      report = report & cat & " = " & Dcounts(dept)(cat) & IIf(i < 3, ", ", "") 
     Next i 
    Next dept 

    MsgBox report 
End Sub 

爲了測試它，我列的C創建隨機數據和H是有你的鏈接圖片的格式，然後運行它。我的輸出：

Department 5: No Show = 1, Appt = 1, Can = 1, walk = 2 
Department 3: No Show = 5, Appt = 2, Can = 1, walk = 2 
Department 4: No Show = 2, Appt = 1, Can = 0, walk = 1 
Department 2: No Show = 2, Appt = 1, Can = 2, walk = 1 
Department 1: No Show = 1, Appt = 1, Can = 0, walk = 2 

這表明鍵，當你重複的順序是隨機的一點 - 但你可以做這樣的事情有一個對j = 1至5環，而不是一個在鑰匙圈各部門。