Question

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

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

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

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

Answer 1

以下是常见的解决方案。在标准模块中输入以下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

然后使用如下：

另外两个案例的变化很小。

Answer 2

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

备注：

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

Arg1 ：rng1范围对象1，例如细胞A2

Arg2 ：rng2范围对象2，例如细胞B2

Arg3 ：calcOption; "C" =普通，"A"是唯一的，"B"仅为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

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

2 个答案: