比较3个范围而不是2个

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比较2个范围并返回匹配值的数量。 我想比较3个范围,以便找出在所有3个范围内同时出现了多less个值。

非常感谢任何帮助。

 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 

这个function对我来说很好,告诉我你是否需要改进。

 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

这可以帮助…

 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 

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

这是非vba解决scheme的替代scheme。

考虑这样的数据布局:

sample.jpg

在单元格E2中是这个公式:

 =SUMPRODUCT(--(COUNTIF(B2:B16,A2:A23)>0),--(COUNTIF(C2:C19,A2:A23)>0)) 

为了清晰起见,我已经突出显示了所有三列中匹配的所有单元格。 A列中共有8个单元格,在列B和C中find了重复项。请注意,这将计算A列中的重复项(但您的UDF也已经存在)。