excel - 如何仅计算excel列中的条目一定次数？

Question

我想数一下某家公司按某个标准审核了多少次。F栏某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某某C栏某标​​准的标准被审计次数超过3次，则其中3间公司应计为1、2、3次。若某公司被审计2次，则应计为1次2.如果一家公司只被审计一次，则应计为1。

这是示例（G 列是所需的结果）：

我已经有一个代码，不幸的是它不能满足所有要求。

是否可以相应地调整它？

Sub GroupCertificates_MAX3()
Dim Ws As Worksheet
Dim rngDB As Range, vDB As Variant
Dim s1, s2
Dim r As Long, i As Long
Dim k As Long, n As Long

Set Ws = ActiveSheet

Set rngDB = Ws.UsedRange.Offset(1)
vDB = rngDB

r = UBound(vDB, 1)
s1 = vDB(1, 2)
s2 = vDB(1, 5)

k = 1
For i = 1 To r
    If vDB(i, 2) = s1 And vDB(i, 5) = s2 Then
        n = n + 1
    Else
        vDB(k, 7) = WorksheetFunction.Min(3, n)
        k = i
        n = 1
        s1 = vDB(i, 2)
        s2 = vDB(i, 5)
    End If
Next i
rngDB = vDB

End Sub

标签： excelvbaexcel-2016

Answer 1

这是嵌套字典的工作。意识到一个字典项可以是另一个字典可能有点费力。此外，如果没有 'with' 语法，事情会很快变得非常冗长

Public Sub CountUsingDictionaries()

    Dim myCompanies As Variant
    myCompanies = GetColumnArrayFromExcel(ThisWorkbook.Sheets(1).Range("F2:F11"))
    
    Dim myStandard As Variant
    myStandard = GetColumnArrayFromExcel(ThisWorkbook.Sheets.Item(1).Range("B2:B11"))
    
    Dim myCounter As Scripting.Dictionary
    Set myCounter = New Scripting.Dictionary
    
    Dim myResult As Scripting.Dictionary
    Set myResult = New Scripting.Dictionary
    
    Dim myIndex As Long
    For myIndex = LBound(myCompanies) To UBound(myCompanies)
    
        Dim myCKey As String
        myCKey = myCompanies(myIndex)
        
        Dim mySKey As String
        mySKey = myStandard(myIndex)
        
        If Not myCounter.exists(myCKey) Then
        
            myCounter.Add myCKey, New Scripting.Dictionary
            
        End If
        
        With myCounter.Item(myCKey)
        
            If Not .exists(mySKey) Then
            
                .Add mySKey, 0
                
            End If
            
            .Item(mySKey) = .Item(mySKey) + 1
            
            If .Item(mySKey) > 3 Then
            
                myResult.Add myIndex, " "
                
            Else
            
                myResult.Add myIndex, .Item(mySKey)
                
            End If
            
        End With
        
    Next
    
    ThisWorkbook.Sheets.Item(1).Range("G2:G11") = Application.WorksheetFunction.Transpose(myResult.Items)
        
End Sub


Public Function GetColumnArrayFromExcel(ByVal ipRange As Excel.Range) As Variant
' This is a workaround for an idiosyncracy of Excel which returns a
' 2D variant array when the request is only for a 1D array
' If you need an array from a row then you need two transpose actions

    GetColumnArrayFromExcel = Application.WorksheetFunction.Transpose(ipRange.Value)

End Function

上面的代码是用