Časť problému vyriešená. Síce neviem či efektívne, ale funguje to. :)



Public Function SpolocneZaznamy(Oblast1 As Range, Optional Oblast2 As Range) As Variant
' vyberie také hodnoty z dvoch oblastí ktoré sa nachádzajú v obidvoch oblastiach minimálne 1x
' funkcia napísaná s pomocou knihy: Melanie Dreden, Michael Schwimmer - Excel 2007 VBA - Riešenie 99

Dim colX As New Collection
Dim col2X As New Collection
Dim KolekciaHlavna As New Collection
Dim rngX As Range
Dim i As Long
Dim Pole() As Variant

On Error Resume Next
' Naplnenie zoznamu z prvej oblasti a
' Vylúčenie rovnakých hodnôt v danej oblasti
For Each rngX In Oblast1
If rngX.Value <> "" Then
Err.Clear
' Testovanie, či se obsah bunky môže vložit do kolekcie ako klúč
colX.Add rngX.Value, "X" & rngX.Value
If Err.Number = 457 Then
' Ak sa objaví chyba 457, tak už záznam existuje.
' Porovnávanie funguje ako LIKE, nerozlišujú se malé a velké písmená.
End If
End If
Next rngX

If Oblast2 Is Nothing Then
ReDim Pole(1 To colX.Count)
For i = 1 To colX.Count
Pole(i) = colX.item(i)
Next i
GoTo Koniec
Else
' Vylúčenie rovnakých hodnôt v druhej oblasti
For Each rngX In Oblast2
If rngX.Value <> "" Then
Err.Clear
col2X.Add rngX.Value, "X" & rngX.Value
If Err.Number = 457 Then
End If
End If
Next rngX

' Do novej kolekcie sa zapíšu len tie záznamy ktoré sa nachádzajú v obidvoch oblastiach minimálne 1x
For i = 1 To col2X.Count
Err.Clear
colX.Add col2X.item(i), "X" & col2X.item(i)
If Err.Number = 457 Then
KolekciaHlavna.Add col2X.item(i), "X" & col2X.item(i)
End If
Next i
ReDim Pole(1 To KolekciaHlavna.Count)
For i = 1 To KolekciaHlavna.Count
Pole(i) = KolekciaHlavna.item(i)
Next i
End If
Koniec:
On Error GoTo 0
SpolocneZaznamy = Pole()
End Function