AD 1 i 2)
Utwórz sobie nowy moduł i nazwij go, np. Functions, a następnie umieść w nim taki kod:
' 0 - różne
' 1 - podobne
' 2 - identyczne
Public Function DuplicateExists(ByVal row As Range, ByVal tabel As Range) As Integer
Dim result, compareResult As Integer
Dim original, copy As String
Dim i, j As Integer
result = 0
For i = 1 To tabel.Rows.Count
For j = 1 To row.Columns.Count
original = row.Cells(1, j).Value
copy = tabel.Cells(i, j).Value
compareResult = Compare(original, copy)
If compareResult = 0 Then
result = 0
Exit For
ElseIf Not result = 1 Then
result = compareResult
End If
Next j
If result = 1 Or result = 2 Then Exit For
Next i
DuplicateExists = result
End Function
Private Function Compare(ByVal value1 As String, ByVal value2 As String) As Integer
Dim i, j, minStringLength, result As Integer
Dim value1Split, value2Split As Variant
Dim value1NoSpaces, value2NoSpaces, ignoredStrings As String
result = 0
value1NoSpaces = Replace(Trim(value1), " ", "")
value2NoSpaces = Replace(Trim(value2), " ", "")
ignoredStrings = "inc.;" ' łańcuchy znaków muszą być wstawiane bez spacji
minStringLength = 3
If Len(value1NoSpaces & "") = 0 And Len(value2NoSpaces & "") = 0 Then
result = 2
ElseIf Len(value1NoSpaces & "") = 0 Or Len(value2NoSpaces & "") = 0 Then
result = 0
ElseIf StrComp(value1, value2, vbBinaryCompare) = 0 Then
result = 2
ElseIf StrComp(value1NoSpaces, value2NoSpaces, vbTextCompare) = 0 Then
result = 1
Else
value1Split = Split(Trim(value1), " ")
value2Split = Split(Trim(value2), " ")
For i = LBound(value1Split) To UBound(value1Split)
If Not (Len(value1Split(i) & "") < minStringLength Or _
InStr(1, ignoredStrings, value1Split(i), vbTextCompare) > 0) Then
For j = LBound(value2Split) To UBound(value2Split)
If Not Len(value2Split(j) & "") < minStringLength And _
StrComp(value1Split(i), value2Split(j), vbTextCompare) = 0 Then
result = 1
End If
Next j
End If
Next i
End If
Compare = result
End Function
Następnie w arkuszu nr 1 w kolumnie E wstaw taki kod: =DuplicateExists(A2:D2;Arkusz2!$A$2:$D$4)
Funkcja DuplicateExists zwraca wartość 2, gdy w tabeli Arkusz2!$A$2:$D$8 istnieje identyczny wiersz jak A2:D2.
Funkcja DuplicateExists zwraca wartość 1, gdy w tabeli Arkusz2!$A$2:$D$8 istnieje wiersz podobny do A2:D2.
Funckja DuplicateExists zwraca wartość 0, gdy w tabeli Arkusz2!$A$2:$D$8 nie istnieje wiersz podobny do A2:D2.
Potestuj i daj znać, czy wszystko jest OK.
