查找号码。时间价值与其他组合发生

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环，而不是一个在钥匙圈各部门。