Excel宏计算2列中的唯一值

Question

我一直在寻找这个问题的答案，但一无所获。

也许这里有人能帮我。

我有一个有2列的csv

ColA    ColB

Mark     prim
Mark     sec
Mark     prim
John     prim
Mark    sec

我需要一个计算唯一数据的宏。ColA必须是唯一的，并且在ColB中必须包含"prim“。

上面例子的结果是2. Mark prim John prim

谢谢！

Answer 1

定义一个集合，并在ColB等于"prim“时从ColA连续向其添加项。然后输出集合的内容。

如果需要将项目连接回其在ColA中的第一个匹配项，请使用ColA的文本值作为项键，并使用RowNumber作为项值。

Answer 2

按组计算唯一值

​

​

Option Explicit

Sub CountUniqueByGroupTEST()
    ' Assumptions
    ' The data is contiguous (no empty rows or columns). It is in table format
    ' (one row of headers), and starts in cell "A1" (in the only worksheet)
    ' of a CSV file.
    
    ' Change path.
    Dim wb As Workbook
    Set wb = Workbooks.Open("C:\Test\Test.csv")
    'Set wb = ThisWorkbook
    
    ' Source Current Region Range
    Dim scrrg As Range
    Set scrrg = wb.Worksheets(1).Range("A1").CurrentRegion
    ' Source Range (without headers)
    Dim srg As Range: Set srg = scrrg.Resize(scrrg.Rows.Count - 1).Offset(1)
    If srg.Columns.Count < 2 Then Exit Sub ' too few columns
    ' Unique Column
    Dim UniqueColumn As Long: UniqueColumn = srg.Columns(1).Column
    ' Group Column Range
    Dim GroupColumnRange As Range: Set GroupColumnRange = srg.Columns(2)
    
    Dim uCount As Long
    uCount = CountUniqueByGroup(UniqueColumn, GroupColumnRange, "prim")

    ' Continue with code...
    MsgBox "Unique Values Count = " & uCount, vbInformation, "Unique by Group"
    Debug.Print uCount
    
    ' Maybe close the file.
    'wb.Close SaveChanges:=False

End Sub

Function CountUniqueByGroup( _
    ByVal UniqueColumn As Long, _
    ByVal GroupColumnRange As Range, _
    ByVal GroupString As String) _
As Long
    On Error GoTo ClearError
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' ignore case e.g. 'Mark = MARK'
             
    Dim gCell As Range
    Dim gValue As Variant
    Dim uValue As Variant
    
    For Each gCell In GroupColumnRange.Cells
        gValue = CStr(gCell.Value)
        If StrComp(gValue, GroupString, vbTextCompare) = 0 Then
            uValue = gCell.EntireRow.Columns(UniqueColumn).Value
            If Not IsError(uValue) Then ' exclude error values
                If Len(uValue) > 0 Then ' exclude blanks
                    dict(uValue) = Empty
                End If
            End If
        End If
    Next gCell
    
    CountUniqueByGroup = dict.Count

'    ' Print the unique values in the Immediate window ('Ctrl+G').
'    If CountUniqueByGroup > 0 Then
'        Debug.Print Join(dict.keys, vbLf)
'    End If
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume ProcExit
End Function