сравнить 3 диапазона вместо 2

Question

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 диапазона вместо этого, чтобы узнать, сколько значений появилось во всех трех диапазонах одновременно.

Очень ценю любую помощь.

Answer 1

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 

Answer 2

Эти функции отлично работают для меня, скажите мне, нужно ли вам некоторое улучшение.

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 

Добавлено больше комментариев к этой функции.

Answer 3

А вот альтернатива для решения, отличного от vba.

Рассмотрим макет данных, например, так:

В ячейке Е2 эта формула:

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

Я выделил все клетки, которые имеют матчи во всех трех столбцах для ясности , В столбце A содержится 8 ячеек, которые имеют дубликаты, найденные в столбцах B и C. Обратите внимание, что это будет считать дубликаты в столбце A (но также и ваш UDF).