我正在尝试创建一个UDF以查找包含2列的唯一值。我有一张纸,其中包含有关公司员工的数据。我需要计算特定位置的员工人数。问题是,由于数据集的性质,某些员工在特定位置出现多次。计算唯一细胞的公式不是问题,我使用:
IF(SUMPRODUCT(($A$1:$A1=A1)*($B$1:$B1=B1))>1;0;1)
不过,我希望能够在其他工作表中使用此功能,以便我或其他用户选择要在其中搜索值的列的值。
[我试图编写公式,但是,由于我对VB相当陌生,所以我无法考虑如何在公式中获得$符号。
有人知道我可以适应自己的需求吗? T.i.a。!
我相信您正在寻找类似下面的代码的代码,它将使用户可以在一张工作表上选择两列,并检查有多少唯一的项目以及可以找到多少重复的组合:
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