MS Excel

To bude veľmi záležať na tom ako to chcete použiť, čo od toho očakávate za funkcionalitu, aké chovanie napr. pri prázdnych bunkách, koľko to má mať parametrov (tu je príklad na multioblasti) ...

Veľkým problémom bude napr. napodobniť chovanie UNIQUE v E2021, kde sa výsledok na viac riadkov stane automaticky FormulaArray, a alokuje potrebný počet riadkov pod funkciou, a ten počet riadkov si pamätá a mení podľa potreby.
To je problém. Áno, do funkcie môžete pridať parameter referenčnej bunky od ktorej dole sa budú vypisovať jedinečné hodnoty, ale tá funkcia si ten počet nedokáže zapamätať. Iste môžete urobiť globálnu premennú, kde si to bude pamätať, ale stačí debugovať makro, a hodnota je fuč, stačí otvoriť súbor a hodnota nie je. Ako potom zisťovať pokiaľ boli vypísané minulé hodnoty? Čo ak sú pod tabuľkou iné dáta? Ak nie sú, tak je zasa problém použiť na zistenie posledného riadku xlUp pri použitom filtrovaní (v E2021 zase pre zmenu prestala fungovať doteraz spoľahlivá metóda zisťovania posledného riadku aj napriek filtru, a to cez Find, aj keď zase doprogramovávať funkciu UNIQUE v E2021 by bolo potrebné iba v špeciálnom prípade ako tu - multioblasti a pod), atď.

Problémov môže byť neúrekom. A to som sa zamyslel nad témou len trošku. Ako som písal - záleží na použití.

Public Function XUNIQUE(bBlank As Boolean, ParamArray paRNG()) As Variant
Dim RNG As Range
Dim cCol As New Collection
Dim aRes() As Variant, aVal() As Variant
Dim xRows As Long, xColumns As Integer, r As Long, c As Integer, i As Long

'pracuje i s nesouvislou multioblastí
For i = LBound(paRNG) To UBound(paRNG)
Set RNG = paRNG(i)

xRows = RNG.Rows.Count
xColumns = RNG.Columns.Count

'načtení hodnot
If xRows * xColumns = 1 Then
ReDim aVal(1 To 1, 1 To 1)
aVal(1, 1) = RNG.Value
Else
aVal = RNG.Value
End If

'kontrola jedinečnosti hodnot
On Error Resume Next
For c = 1 To xColumns
For r = 1 To xRows
'co s Empty a "" ?
If LenB(aVal(r, c)) > 0 Then
cCol.Add aVal(r, c), CStr(aVal(r, c))
ElseIf bBlank Then
cCol.Add "", ""
End If
Next r
Next c
On Error GoTo 0
Next i

If cCol.Count > 0 Then
ReDim aRes(1 To cCol.Count, 1 To 1)

'načtení jedinečních hodnot z kolekce
For r = 1 To cCol.Count
aRes(r, 1) = cCol(r)
Next r

XUNIQUE = aRes
Else
XUNIQUE = CVErr(xlErrNA)
End If

Set cCol = Nothing
End Functioncitovat