使用其他条件计算唯一 ID

Question

每个分配的标签应该在初始化时使用其唯一的具有相同名称、月份和颜色的 BookID 来获取彩色书籍的数量。

原始数据图像：

原始数据文本：

BookID  Name    Month       Color
101     Jack    January     Red
101     Jack    January     Red
101     Jack    January     Red
101     Jack    January     Red
101     Jack    January     Red
101     Jack    January     Red
101     Jack    January     Red
102     Jack    January     Red
102     Jack    January     Red
102     Jack    January     Red
103     Jack    January     Red
104     Jack    February    Red
108     Jack    January     Blue
108     Jack    January     Blue
108     Jack    January     Blue
108     Jack    January     Blue
108     Jack    January     Blue
101     Thomas  January     Red
101     Thomas  January     Red
102     Thomas  January     Red
104     Thomas  February    Red
105     Thomas  March       Orange
105     Thomas  March       Orange
105     Thomas  March       Orange
106     Thomas  March       Orange
107     Thomas  April       Blue
109     Thomas  April       Orange
110     Thomas  April       Orange
111     Thomas  April       Orange
112     Thomas  April       Orange
113     Thomas  April       Red
114     Thomas  April       Red
107     Thomas  May         Blue

请注意，BookID 是无限的。 BookID 从 101 开始，一直到一个非常大的图书馆中的最后一本书，并且还会有新书出现。因此，还有另一个 VBA 表单不断将 BookID 及其数据（名称、月份和颜色）提交到工作表（Sheet3），这已经解决了。我想做的只是计算同一张表中一个月内具有相同名称和颜色的唯一 BookID。我真的很难获取具有相同颜色的随机唯一 BookID 的总数。标签中显示的 BookID 计数和总数是动态的，而标签中显示的名称、月份、颜色是静态的。

请查看下面所需的输出：

如果您要按月手动过滤 Sheet3，您将能够看到这些数据，这些数据是红色计数的 BookID，显示在下面的表单标签中。

我对 VBA 比较陌生，我不知道如何组织和分析下面的代码以获得上面所需的输出。由于有很多标签，上面的输出有很多变量需要在代码中声明。我可以有一个代码，只获取杰克和托马斯一月份的结果，只要我能得到它是如何完成的逻辑，这样我就可以继续获取接下来几个月的结果。如果可以通过使用 ListBox/es 的列表来完成此操作，该列表将在“名称”列中包含 Jack 和 Thomas，在“颜色”列（红色列、橙色列、蓝色列）中进行计数，并在最后一列中包含所有颜色的总计数。 ListBox，也可以啊

我坚持的代码：

Sub trial2()
        Dim ws As Worksheet, rng As Range, count As Long, k As Long
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet3")
        Set rng = ws.Range("A1:D" & ws.Cells(Rows.count, "A").End(xlUp).Row)
        arrData = rng.value
        Dim sID As Variant, sName As Variant, sMonth As Variant, sColor As Variant
        Dim JanuaryCountJackRed As Double, JanuaryCountJackOrange As Double, JanuaryCountJackBlue As Double
        
        'i cannot declare a specific value for sID here because the whole real sheet has so plenty of BookIDs

        'JanuaryCountJackRed = WorksheetFunction.CountIfs( ...)
        'JanuaryCountJackOrange = WorksheetFunction.CountIfs( ...)
        'JanuaryCountJackBlue = WorksheetFunction.CountIfs( ...)
        
        'Me.JanuaryJackRed.Caption = JanuaryCountJackRed
        'Me.JanuaryJackOrange.Caption = JanuaryCountJackOrange
        'Me.JanuaryJackBlue.Caption = JanuaryCountJackBlue
        'Me.JanuaryJackTotal.Caption = JanuaryCountJackRed + JanuaryCountJackOrange + JanuaryCountJackBlue
End Sub

提前非常感谢您的帮助..

Answer 1

我会使用数组来实现更结构化的方式。您可以通过在 Array() 中插入其他数据来快速扩展此代码。这是代码供您参考。

Sub GenerateReport()
    Dim ws As Worksheet, wsReport As Worksheet
    Dim LastRow As Long
    Dim Persons() As Variant, Months() As Variant, Colors() As Variant
    Dim i As Long, j As Long, k As Long, startCol As Long
    
    'Initialize arrays
    Persons = Array("Jack", "Thomas")
    Months = Array("January", "February", "March", "April")
    Colors = Array("Red", "Orange", "Blue")
    
    Set ws = ThisWorkbook.Worksheets("Sheet3")
    Set wsReport = ThisWorkbook.Worksheets.Add
    wsReport.Name = "Report"
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'Loop through Months
    For i = LBound(Months) To UBound(Months)
        wsReport.Cells(i * 4 + 1, 1).Value = Months(i)
        
        'Loop through Persons
        For j = LBound(Persons) To UBound(Persons)
            startCol = j * 10 + 1
            wsReport.Cells(i * 4 + 2, startCol).Value = Persons(j)
            
            Dim TotalCount As Long
            TotalCount = 0
            
            'Loop through Colors
            For k = LBound(Colors) To UBound(Colors)
                wsReport.Cells(i * 4 + 3, startCol + k * 2).Value = Colors(k)
                Dim ColorCount As Long
                ColorCount = Application.WorksheetFunction.CountIfs(ws.Range("B2:B" & LastRow), Persons(j), _
                                                                     ws.Range("C2:C" & LastRow), Months(i), _
                                                                     ws.Range("D2:D" & LastRow), Colors(k))
                wsReport.Cells(i * 4 + 3, startCol + k * 2 + 1).Value = ColorCount
                TotalCount = TotalCount + ColorCount
            Next k
            
            'Display Total
            wsReport.Cells(i * 4 + 3, startCol + k * 2).Value = "Total"
            wsReport.Cells(i * 4 + 3, startCol + k * 2 + 1).Value = TotalCount
        Next j
    Next i
End Sub