如何使用公式分隔单元格值并在 Excel 中进行比较？

Question

如下图所示，我有两个值（A 和 B）。我想使用 A 和 B 计算下面提到的值。

1. 常见： A 和 B 中常见值的百分比（例如，第一个示例中只有 4 个常见。因此，百分比为 1/4）
2. 仅 A：仅 A 项的百分比（例如，在第一个示例 1 中，5 个仅在 A 中。因此百分比为 2/4）
3. 仅 B：仅 B 项的百分比（例如，在第一个示例中，6 仅在 B 中。因此百分比为 1/4）

我找不到合适的 Excel 公式来将一个单元格中的数字除以逗号并将其与下一列单元格进行比较（例如，1,4,5 与 4,6）。如果有任何特定的 ms-excel 公式可以用于此，请告诉我。

如果需要，我很乐意提供更多详细信息 :)

Answer 1

使用带有选项参数的 UDF 进行输出计算。

---

注意事项：

功能 GetPercentage。根据传入的选项参数返回百分比。

Arg1：rng1 范围对象 1 例如单元格 A2

Arg2：rng2 范围对象 2 例如单元格 B2

Arg3：calcOption； "C" = 普通，"A" 是唯一的，"B" 是唯一的。

---

代码：

Option Explicit

Public Function GetPercentage(ByRef rng1 As Range, ByRef rng2 As Range, ByVal calcOption As String) As Double
    Application.Volatile
    'calcOption C  = Common , A is a only, B is B only.
    Dim arr1() As String, arr2() As String, totalAItems As Long, totalBItems As Long, totalItems As Long
    arr1 = Split(rng1.Value, ",")
    arr2 = Split(rng2.Value, ",")
    totalAItems = GetDistinctCount(arr1)
    totalBItems = GetDistinctCount(arr2)
    totalItems = GetDistinctCount(Split(rng1.Value & "," & rng2.Value, ","))
    Dim commonItemCount As Long
    commonItemCount = GetSharedCount(arr1, arr2)

    Select Case calcOption
    Case "C"
        GetPercentage = commonItemCount / totalItems
    Case "A"
        GetPercentage = OnlyInOneCell(arr1, arr2) / totalItems
    Case "B"
        GetPercentage = OnlyInOneCell(arr2, arr1) / totalItems
    End Select

End Function

Public Function GetDistinctCount(ByVal arr As Variant) As Long
    Dim tempDict As Object, i As Long
    Set tempDict = CreateObject("Scripting.Dictionary")

    For i = LBound(arr) To UBound(arr)
        If Not tempDict.Exists(arr(i)) Then tempDict.Add arr(i), arr(i)
    Next i

    GetDistinctCount = tempDict.Count

End Function

Public Function GetSharedCount(ByVal arr1 As Variant, ByVal arr2 As Variant) As Long
    Dim outCount As Long, i As Long
    For i = LBound(arr1) To UBound(arr1)
        If Not IsError(Application.Match(arr1(i), arr2, 0)) Then outCount = outCount + 1
    Next i

    GetSharedCount = outCount

End Function

Public Function OnlyInOneCell(ByVal arr1 As Variant, ByVal arr2 As Variant) As Long
    Dim outCount As Long, i As Long, tempDict As Object
    Set tempDict = CreateObject("Scripting.Dictionary")
    For i = LBound(arr1) To UBound(arr1)
        If IsError(Application.Match(arr1(i), arr2, 0)) Then
            If Not tempDict.Exists(arr1(i)) Then tempDict.Add arr1(i), arr1(i)
        End If
    Next i
    OnlyInOneCell = tempDict.Count
End Function

---

工作表中的 UDF

Answer 2

这是common的解决方案。在标准模块中输入以下 UDF：

Public Function Kommon(s1 As String, s2 As String) As Double
    Dim arry1, arry2, C As Collection

    arry1 = Split(s1, ",")
    arry2 = Split(s2, ",")

    Set C = New Collection
    On Error Resume Next
        For Each a In arry1
            C.Add a, CStr(a)
        Next a
        For Each a In arry2
            C.Add a, CStr(a)
        Next a
    On Error GoTo 0
    cc = CDbl(C.Count)

    For Each a In arry1
        For Each b In arry2
            If a = b Then
                k = k + 1
                Exit For
            End If
        Next b
    Next a

    Kommon = k / cc

End Function

然后按如下方式使用：

其他两种情况是这种情况的微小变化。