Excel 宏計算 2 列中的唯一值

Question

我一直在尋找答案，但沒有運氣。

也許這里有人可以幫助我。

我有這個 csv 有 2 列

ColA    ColB

Mark     prim
Mark     sec
Mark     prim
John     prim
Mark    sec

我需要一個計算唯一數據的宏。 ColA 必須是唯一的，並且在 ColB 中必須包含“prim”。

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

謝謝 ！

Answer 1

定義一個Collection，然后在ColB等於“ prim”時，從ColA中向其連續添加項目。 然后輸出集合的內容。

如果你需要的物品帶回連接到可樂中首次出現時使用的文本值OT 可樂作為項目重點，而作為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