Question

我有一个包含部门的列和另一个包含Appt，Can，No show的列。我想计算每个部门为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

检查每个部门的Appt，Can，walk和No Show的代码。

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

Byron Wall是正确的，Pivot Tables是一个很自然的选择 - 但你也可以简化VBA。你知道字典，但可能会更多地利用它们。我建议使用早期绑定 - 在工具/参考中添加对 Microsoft Scripting Runtime 的引用，然后您可以按以下行编写代码。主循环填充键入部门的字典。此词典的值本身是由您的类别键入的词典（“No Show”等）。这些词典的值是您所追求的计数。在代码的最后，我将展示如何从这个数据结构中提取数据：

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循环而不是键循环中每个dept的东西。

发现没有。时间与其他组合

1 个答案: