在工作表的2列中查找唯一值

问题描述 投票:0回答:1

我正在尝试创建一个UDF以查找包含2列的唯一值。我有一张纸,其中包含有关公司员工的数据。我需要计算特定位置的员工人数。问题是,由于数据集的性质,某些员工在特定位置出现多次。计算唯一细胞的公式不是问题,我使用:

IF(SUMPRODUCT(($A$1:$A1=A1)*($B$1:$B1=B1))>1;0;1)

不过,我希望能够在其他工作表中使用此功能,以便我或其他用户选择要在其中搜索值的列的值。

[我试图编写公式,但是,由于我对VB相当陌生,所以我无法考虑如何在公式中获得$符号。

有人知道我可以适应自己的需求吗? T.i.a。!

excel vba user-defined-functions
1个回答
0
投票

我相信您正在寻找类似下面的代码的代码,它将使用户可以在一张工作表上选择两列,并检查有多少唯一的项目以及可以找到多少重复的组合:

Sub CountUnique()
Dim v1 As Range, v2 As Range
Dim arrFirstCol As Variant, arrSecondCol As Variant, arrCombinations()
Dim unique As New Scripting.Dictionary
Dim key As Variant

Set v1 = Application.InputBox("First list", "Select First Column", Type:=8)
'let user select Column
LastRow = v1.Cells(v1.Rows.Count, 1).End(xlUp).Row
'get the last row with data in given column
arrFirstCol = Range(Cells(1, v1.Column), Cells(LastRow, v1.Column))
'assign data to Array

Set v2 = Application.InputBox("Second list", "Select Second Column", Type:=8)
LastRow2 = v2.Cells(v2.Rows.Count, 1).End(xlUp).Row
arrSecondCol = Range(Cells(1, v2.Column), Cells(LastRow2, v2.Column))

'If LastRow <> LastRow2 Then
''check if both arrays have equal dymensions, if needed
'    MsgBox "Dymension of both lists don't match", vbInformation, "Error"
'    Exit Sub
'End If

ReDim arrCombinations(1 To LastRow)

For i = LBound(arrFirstCol) To UBound(arrFirstCol)
    arrCombinations(i) = arrFirstCol(i, 1) & arrSecondCol(i, 1)
    'add all possible combinations into another Array
Next i

For i = LBound(arrCombinations) To UBound(arrCombinations)
    If Not unique.Exists(arrCombinations(i)) Then
        unique.Add arrCombinations(i), 1
    Else
        unique.Item(arrCombinations(i)) = unique.Item(arrCombinations(i)) + 1
    End If
Next

For Each key In unique.Keys
    Sum = Sum + unique(key)
Next

MsgBox "This is the number of unique combinations: " & unique.Count
MsgBox "This is the number of duplicates: " & Sum - unique.Count
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.