首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >比较3个范围而不是2个范围

比较3个范围而不是2个范围
EN

Stack Overflow用户
提问于 2016-02-08 18:33:58
回答 3查看 103关注 0票数 0
代码语言:javascript
复制
Public Function Compare(r1 As Range, r2 As Range) As Long
   Dim r As Range, v As Variant, v2 As Variant
   Dim rr As Range
   For Each r In r1
      v = r.Value
      If v <> 0 And v <> "" Then
         For Each rr In r2
            v2 = rr.Value
            If v = v2 Then Compare = Compare + 1
         Next rr
      End If
   Next r
End Function

此UDF比较两个范围并返回匹配值的数目。我想比较三个范围,以找出有多少值出现在所有三个范围同时。

非常感谢你的帮助。

EN

回答 3

Stack Overflow用户

回答已采纳

发布于 2016-02-08 19:12:57

代码语言:javascript
复制
Public Function Compare(r1 As Range, r2 As Range, r3 As Range) As Long
   Dim r As Range, v As Variant, m1 As Variant, m2 As Variant
   Dim rv As Long

   rv = 0
   For Each r In r1
      v = r.Value
      If v <> 0 And v <> "" And Not IsError(v) Then
            m1 = Application.Match(v, r2, 0)
            m2 = Application.Match(v, r3, 0)
            If Not IsError(m1) And Not IsError(m2) Then
               rv = rv + 1
            End If
      End If
   Next r
   Compare = rv
End Function
票数 6
EN

Stack Overflow用户

发布于 2016-02-08 18:57:22

这个功能对我很好,如果你需要改进的话,告诉我。

代码语言:javascript
复制
Public Function Compare(r1 As Range, r2 As Range, r3 As Range) As Long
    Dim i
    Dim v1
    Dim v2
    Dim v3
    Dim counter

    counter = 0
    For Each i In r1
        counter = counter + 1
        v1 = r1(counter).Value
        v2 = r2(counter).Value
        v3 = r3(counter).Value

        If v1 = v2 And v2 = v3 Then
            'r3(counter).Offset(0, 2).Value = "OK" 'this is for the test
            Compare = Compare + 1
            'I think could be easy to test and return a value...
            'Compare = v1 'Because is the same value in the 3 cells
        Else
            'r3(counter).Offset(0, 2).Value = "NO"'this is for the test
            'Do another code...

        End If
    Next i
End Function

编辑#1

这能帮上忙..。

代码语言:javascript
复制
Public Function Compare2(r1 As Range, r2 As Range, r3 As Range) As Long
    Dim i
    Dim v1
    Dim v2
    Dim v3
    Dim counter
    Dim n1 As Range
    Dim n2 As Range
    Dim n3 As Range
    Dim max

    counter = 0
    max = Application.WorksheetFunction.max(r1.Count, r2.Count, r3.Count)
    'With "max" take the max number of rows in the range to use it

    Set n1 = Range(Cells(r1(1).Row, r1(1).Column), Cells(r1(1).Row + max - 1, r1(1).Column))
    Set n2 = Range(Cells(r2(1).Row, r2(1).Column), Cells(r2(1).Row + max - 1, r2(1).Column))
    Set n3 = Range(Cells(r3(1).Row, r3(1).Column), Cells(r3(1).Row + max - 1, r3(1).Column))
    'Here we set new ranges, equals all of them, to use them in the for loop and compare
    'we use the ref of the input ranges.

    counter = 0
    For Each i In n1
        counter = counter + 1 'this is the index for the new ranges
        v1 = n1(counter).Value 'store every value of the new ranges
        v2 = n2(counter).Value
        v3 = n3(counter).Value

        If v1 = v2 And v2 = v3 Then 'do the comparison, and if the 3 values are equal
            'n3(counter).Offset(0, 2).Value = "OK" 'this is just for the test
            Compare2 = Compare2 + 1 'add 1 to compare
        Else
            'n3(counter).Offset(0, 2).Value = "NO"
            'this part of the code don't do anything
            'but if you want to put some code is up to you.
            'You can delete from Else to this comment
        End If
    Next i
End Function

向函数添加了更多的注释。

票数 1
EN

Stack Overflow用户

发布于 2016-02-08 20:00:45

以下是非vba解决方案的替代方案。

考虑这样的数据布局:

在单元格中,E2是这样的公式:

代码语言:javascript
复制
=SUMPRODUCT(--(COUNTIF(B2:B16,A2:A23)>0),--(COUNTIF(C2:C19,A2:A23)>0))

为了清晰起见,我高亮显示了所有三列中都有匹配的单元格。在A列中总共有8个单元格具有B和C列中的重复项,请注意,这将在A列中计算重复值(但您的UDF也是如此)。

票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/35276789

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档