'PRONALAZI ZADNJI RED
Function zadnji_red(sh As Worksheet)

    On Error Resume Next
    zadnji_red = sh.Cells.Find(what:="*", _
                            After:=sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
Function kombinacije()
Dim i As Integer, n As Integer, m As Integer, z As Integer, Broj_Redova As Integer
Dim sit As Worksheet

Dim a As Single
a = Timer
Set sit = ActiveSheet
Broj_Redova = zadnji_red(sit)
sit.Range("L1:O" & Broj_Redova).ClearContents
'Broj_Redova = 5500
ReDim podaci(Broj_Redova, 6) As Integer

For i = 1 To Broj_Redova
    For n = 1 To 6
    podaci(i, n) = Cells(i, n)
    Next n
Next i
For i = 1 To Broj_Redova - 1
     For z = i + 1 To Broj_Redova
        broj_istih = 0
        For n = 1 To 6
            For m = 1 To 6
                If podaci(i, n) = podaci(z, m) Then
                broj_istih = broj_istih + 1
                Exit For
                End If
            Next m
            If n - broj_istih > 1 Then
            Exit For
            End If
        Next n
                If broj_istih = 5 Then
                Cells(i, 13) = Cells(i, 13) & z & ","
                Cells(z, 13) = Cells(z, 13) & i & ","
                ElseIf broj_istih = 6 Then
                Cells(i, 15) = Cells(i, 15) & z & ","
                Cells(z, 15) = Cells(z, 15) & i & ","
                End If
     Next z

Next i
MsgBox (Timer - a)
End Function