< návrat zpět

MS Excel


Téma: Funkce Unique rss

Zaslal/a 12.1.2024 10:46

LugrAhoj kluci,

nevytvářel jste si někdo makro, které vám doplní funkci Unique ve starších verzích Excel?

Vím, že to jde nahradit jinými vzorci jako např.

{=IFERROR(INDEX(A2:A10;POZVYHLEDAT(0;COUNTIF(B2:B$2;A2:A10);0));"")}

Ale mě jde vyloženě a vytvoření funkce makrem.

Moc děkuji za pomoc 1

Zaslat odpověď >

#055925
elninoslov
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 Function
Příloha: zip55925_priklad-xunique.zip (17kB, staženo 1x)
citovat
#055929
Lugr
Děkuji kouknu se na to.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

rozpis zápasů hráčů pro utkání dvou týmů

Anonym • 25.5. 11:54

Hromadné přepsání

elninoslov • 24.5. 10:29

Hromadné přepsání

Nomi • 24.5. 8:32

Index - každý rok začít od 1 Power Query

Alfan • 23.5. 9:17

nepřímý odkaz

elninoslov • 23.5. 0:00

nepřímý odkaz

bordov • 22.5. 18:35

vrácené hodnoty

Anonym • 22.5. 15:46