Calc: Unikalne wystąpienia (po raz trzeci)

Gotowe szablony, skrypty, makropolecenia i rozszerzenia. Tutaj możesz pochwalić i podzielić się swoją twórczością z innymi użytkownikami
Awatar użytkownika
Rafkus
Posty: 520
Rejestracja: czw kwie 12, 2018 10:26 pm

Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Z cztery miesiące, temu na potrzeby forum stworzyłem funkcję UNIKALNE, która to z pewnego tekstu usuwała pewne powtarzające się frazy. Niedawno stworzyłem sobie nową funkcję UNIKALNE2 - wyszukującą i zwracającą tylko niepowtarzalne wyniki z pewnego zakresu. Przyjrzałem się obu tym funkcjom i doszedłem do wniosku, że główny algorytm wyszukiwania działa na tej samej zasadzie. Dlatego połączyłem te dwie funkcje w jedną, oraz dodałem możliwość sortowania wyniku (@Jermor - to akurat był twój pomysł). Oto jej kod:
UWAGA: W poście poniżej jest nowsza - efektywniejsza wersja.

Kod: Zaznacz cały

Function UNIKALNE(dane as variant, optional sort as integer, optional zmienna as string) as variant
REM: Funkcja UNIKALNE: zwraca z pewnego tekstu, komórki lub zakresu danych tylko niepowtarzalne wartości.
REM: Ponadto wynik może zostać automatycznie posortowany
REM: Więcej o funkcji jest tu: https://forum.openoffice.org/pl/forum/viewtopic.php?f=28&p=24335#p24323
dim wynik(0), podziel() as variant
dim i%, j%, ile_w%, ile_d as integer
dim element as variant

REM: dane początkowe
'On Local Error GoTo blad
 ile_w = -1			'ilość wyników, narazie ich brak
 If IsMissing(sort) or not (sort =1 or sort =2) then sort = 0	'czy sortować dane: 0-nie, 1-rosnąco, 2-malejąco
 if IsArray(dane) then			'czy dane są tablicą
   If IsMissing(zmienna) then zmienna = "" 		'zmienna to wartość do pominięcia
   ile_d =  UBound(dane,1)*UBound(dane,2) - 1	'ilość danych
   podziel = dane
 else
   If IsMissing(zmienna) then zmienna = " "		'zmienna to separator
   ile_d = -1									'wyniki połącz w jeden tekst
   dane = replace(dane, "  ", " ")				'pozbycie sie podwójnych spacji
   podziel = split(dane, zmienna)  
   if zmienna <> " " then zmienna = zmienna + " "
 endif 
 
REM: poszukiwanie wartości unikalnych
  for each element in podziel()			'wędrówka po kolejnych danych wejściowych
    if IsEmpty(element) then		'określenie typu elementu
     'Element jest pusty, nie trzeba określać typu
     'UWAGA: W przypadku zakresu danych wejściowych w AOO zaimportowana komórka nigdy nie jest pusta
     'pusta komórka dostaje wartość 0      
    elseif IsNumeric(element) then		
      element = CDBL(element)		'element jest liczbą
    else 
      element = trim(element)		'element jest tekstem, pozbycie się początkowych i końcowych spacji
    endif

    i = 0 'sprawdzaj czy element jest już w tabeli wyników
    do until element = wynik(i) or IsEmpty(element) or element = "" or element = zmienna      	
      'pomijaj puste komórki oraz gdy element jest taki sam jak zmienna
      if ile_w > -1 then i=i+1	'gdy jest już jakiś wynik przejdź do kolejego wyniku
      if i = ile_w+1 then		'popraw pierwszy wynik lub dopisz nowy
        ile_w = i
        ReDim Preserve wynik(ile_w)
        wynik(ile_w) = element
      endif      
    loop 
  next

REM: A może tak posortować dane?
dim zamien as boolean
  j = (ile_w > 0)*(sort>0)
  Do until j=0
    j=0
    for i=0 to ile_w-1
      if not IsNumeric(wynik(i)) and not IsNumeric(wynik(i+1)) then
        'gdy oba wyniki są tekstem to porównaj te teksty ale pisanymi dużymi literami; 
        'niestety teksy zaczynające się polskimi znakami (ł,ć,ż itd.) wylądują na końcu...
        '... gdyż porównuje teksty nie alfabetycznie tylko według kodu ASCII
        zamien = (sort=1 and UCase(wynik(i))>UCase(wynik(i+1)))or(sort=2 and UCase(wynik(i))<UCase(wynik(i+1)))
      else		'porównanie liczb bądź liczby i tekstu
        zamien = (sort=1 and wynik(i)>wynik(i+1))or(sort=2 and wynik(i)<wynik(i+1))
      endif
REM:      if wynik(i)>wynik(i+1) then	'orginalny warunek
      if zamien then
        element=wynik(i) : wynik(i)=wynik(i+1) : wynik(i+1)=element : j=1
      end if
    next
  Loop

REM: Wyniki:
  if ile_d = -1 then		'w formie połączonego tekstu
    UNIKALNE = wynik(0) 
    for i=1 to ile_w 
      UNIKALNE = unikalne + zmienna + wynik(i)
    next i
  elseif UBound(dane,1) > UBound(dane,2) then	' pionowa kolumna bo liczba wierszy w danych jest większa od ilości kolumn
   dim wynik2(ile_d,0)as variant
    for i=0 to ile_w			'wyniki od ile_w do ile_d są puste więc można tutaj zakończyć transpozycję wyników
      wynik2(i,0) = wynik(i)
    next i
    UNIKALNE = wynik2
  else
    ReDim Preserve wynik(ile_d)	'poziomy wiersz wyników ma zająć tyle samo komórek co dane wejściowe
    UNIKALNE = wynik
  endif
    
' exit Function 
'blad:
'  unikalne = "Error"
end Function
Jak działa ta funkcja:
Funkcja ta z pewnego tekstu (przedzielonego jakimiś separatorami) lub zakresu komórek wypisuje tylko unikalne wartości. Składnia tej funkcji :
=UNIKALNE(dane; sort; zmienna)
  • dane - może być tekstem, komórką lub pewnym zakresem danych wejściowych na którym będzie przeprowadzana operacja wyszukiwania.
    UWAGA: W przypadku podania pewnego zakresu danych należy tą formułę zatwierdzić przez jednoczesne wciśnięcie klawiszy CTRL+SHIFT+ENTER, jest to sposób zatwierdzania funkcji macierzowych zwracających pewien obszar danych. Ten obszar będzie tutaj zawsze jedno-wierszowy lub jedno-kolumnowy (zależy to od zakresu wejściowego czy ma więcej wierszy czy kolumn).
  • sort - parametr opcjonalny decydujący czy i jak dane mają być posortowane. Można wprowadzić: 1 - sortuj rosnąco, 2 - sortuj malejąco, 0 - brak lub każda inna wartość - oznacza aby nie sortować;
  • zmienna - parametr opcjonalny w zależności od danych oznacza:
    • - znak separatora dla jednej danej,
    • - wartość do wykluczenia w tabeli danych.
Przykłady zastosowania:
  • =UNIKALNE("na, ma, na, da") - brak podanych parametrów opcjonalnych więc jako separator zostanie uznana spacja, zwrócony zostanie nieposortowany tekst: na, ma, da
  • =UNIKALNE("na, ma, na, da"; 1) - podana dodatkowo 1 oznacza że zwrócony tekst ma zostać posortowany rosnąco, brak podanego ostatniego parametru więc jako separator zostanie uznana spacja: da ma, na,
  • =UNIKALNE(A1; 2; ",") - w komórce A1 znajduje się tekst: "na, ma, na, da"; 2- oznacza że dane mają być posortowane malejąco, separatorem jest przecinek (","); otrzymany tekst: na, ma, da
  • =UNIKALNE(A1:A10) - dane wejściowe mieszczą się w pewnym zakresie. Aby otrzymać wszystkie wyniki PAMIĘTAJ, że taką formułę należy zatwierdzić wciskając jednocześnie CTRL+SHIFT+ENTER.
    W kolumnie A znajdują się przykładowo pozycje:
    • telewizor
      lodówka
      komputer
      komputer
      telewizor
    Wynikiem będzie dziesięcio-komórkowy obszar (bo tyle elementów zawierają dane wejściowe) zawierający nieposortowane = 3 wartości unikalne (telewizor, lodówka, komputer) + reszta komórek pustych.
    UWAGA: Jeśli jesteś użytkownikiem OpenOffice do dodatkowo po wartościach unikalnych dostaniesz w wyniku również jedną wartość zerową. Otóż OpenOffie w Basic ?ma problem? z interpretacją pustej komórki. W tak zaimportowanych danych puste komórki są traktowane przez Basic jako komórki liczbowe z wartością zerową (LibreOffice tego problemu nie ma). Aby temu zapobiec wymyśliłem dwa rozwiązania:
    1. Opcjonalnie można podawać jakąś wartość do pominięcia. Zatem w tym przykładzie można wpisać: =UNIKALNE2(A1:A10;; 0) Teraz w wyniku na pewno dostaniesz tylko 3 wartości unikalne + 7 komórek pustych.
    2. Połączyć wszystkie komórki z zakresu z jakimś tekstem, najlepiej pusty tekst "": =UNIKALNE2(A1:A10 & "") w ten sposób pusta komórka przestała być pusta - (znajduje się tam tekst o długości 0 znaków, fajnie to brzmi :lol: )
  • =UNIKALNE(A1:B10 & ""; 1; "komputer" ) - powiedzmy, że kolumna B jest pusta: wówczas wynikiem będzie pionowy obszar(bo liczba wierszy danych=10 jest większa od liczby kolumn=2) 20 komórek z dwoma posortowanymi rosnąco unikalnymi danymi: lodówka, telewizor (komputer został wykluczony).
EDIT:
Poprawiłem nieco kod;
Uwaga 1: Funkcja ta rozróżnia wielkość liter, wynikiem formuły =UNIKALNE("na NA na da") (separatorem jest spacja) będzie tekst "na NA da"
UWAGA 2: Sortowanie jest niezupełnie alfabetyczne. Tak naprawdę to porównuje znaki według kodu ASCII i w przypadku sortowania rosnącego tekst zaczynający się literą "Ć" (numer kodowy to 198) pojawi się po literze np: "W" (kod 87).
Tabela kodów ASCII
LibreOffice 7.4.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
Jan_J
Posty: 4567
Rejestracja: pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Jan_J »

Cenna inicjatywa; obyśmy mieli długą pamięć, by powoływać się na własne usprawnienia w trakcie przyszłych dyskusji...

Widzę jeden problem:
jak odróżnić użycie dla przeanalizowania zawartości pojedynczej komórki od użycia do jednoelementowej tabeli?
To drugie niby głupie, ale jest przypadkiem granicznym i nie ma powodu, by zmieniać w nim zachowanie przypadku ogólnego.

Mam też odpowiedź:
=unikalne(a1) analizuje tekst z komórki,
=unikalne(a1:a1) analizuje jednoelementowy zakres.
JJ
LO (24.2|7.6) ∙ Python (3.12|3.11|3.10) ∙ Unicode 15 ∙ LᴬTEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Rocky|CentOS)
Awatar użytkownika
Rafkus
Posty: 520
Rejestracja: czw kwie 12, 2018 10:26 pm

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Czy dobrze zrozumiałem: chodzi o to aby formułę zapisaną w ten sposób: =unikalne(a1:a1) potraktowało jak formułę =unikalne(a1) ?
np: A1 = "na, ma, na, da"
=unikalne(a1) -----> "na, ma, da"
obecnie: =unikalne(a1:a1) -----> "na, ma, na, da", a sądzisz że powinno dać: -----> "na, ma, da" ?
LibreOffice 7.4.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
Jan_J
Posty: 4567
Rejestracja: pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Jan_J »

Miałem wątpliwości dot. przypadku granicznego: gdyby ktoś chciał wyjąć unikaty z 1-komórkowego zakresu, to co? Może to głupi przypadek, ale byłoby jeszcze głupiej, gdyby się nie dało tego zrobić.
I zaraz sprawdziłem, że podane wyżej rozróżnienie między a1 i a1:a1 to umożliwia. Tak jak jest, jest OK.
JJ
LO (24.2|7.6) ∙ Python (3.12|3.11|3.10) ∙ Unicode 15 ∙ LᴬTEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Rocky|CentOS)
Awatar użytkownika
Rafkus
Posty: 520
Rejestracja: czw kwie 12, 2018 10:26 pm

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Przedstawiam nową wersję mojej funkcji. Zmieniłem w niej:
  1. Zrezygnowałem z sortowania metodą bąbelkową - okazała się mało wydajna w przypadku większej ilości danych. Przetwarzając 1230 danych, otrzymałem 410 nieposortowanych wyników po około 5 sek. Chcąc otrzymać dane posortowane czas oczekiwania zwiększył się o jakieś 20 sek.
  2. Wyniki są obecnie układane na bieżąco (w kolejności rosnącej), dzięki temu nie musi być sprawdzany każdy wynik. Wybierając jakąś wartość do sprawdzenia ze środka wyników można stwierdzić czy jest ona większa czy też mniejsza od danego elementu i tym samym wykluczyć z dalszego porównywania połowę wyników.
    Obecnie przetwarzając 1230 danych otrzymuję 410 posortowanych wyników po około 3 sek.
  3. Dodałem możliwość sortowania według zadanego klucza - można do niego dodać jeszcze jakieś inne znaki.

Kod: Zaznacz cały

Function UNIKALNE(dane as variant, optional sort as integer, optional zmienna as string) as variant
REM: Funkcja UNIKALNE: zwraca z pewnego tekstu, komórki lub zakresu danych tylko niepowtarzalne wartości.
REM: Ponadto wynik może zostać automatycznie posortowany
REM: Więcej o funkcji jest tu: https://forum.openoffice.org/pl/forum/viewtopic.php?f=28&p=24335#p24323
dim podziel(),niesort(0), wynik(0) as variant
dim i%, ile_w%, ile_d%, wynik_od%, wynik_do as integer
dim warunek as boolean
dim element as variant

REM: dane początkowe
On Local Error GoTo blad
ile_w = -1         'ilość wyników, narazie ich brak
If IsMissing(sort) or not (sort =1 or sort =2) then sort = 0   'czy sortować dane: 0-nie, 1-rosnąco, 2-malejąco
if IsArray(dane) then         'czy dane są tablicą
   If IsMissing(zmienna) then zmienna = ""       'zmienna to wartość do pominięcia
   ile_d =  UBound(dane,1)*UBound(dane,2) - 1   'ilość danych
   podziel = dane
else
   If IsMissing(zmienna) then zmienna = " "      'zmienna to separator
   ile_d = -1                           'wyniki połącz w jeden tekst
   dane = replace(dane, "  ", " ")            'pozbycie sie podwójnych spacji
   podziel = split(dane, zmienna)
   if zmienna <> " " then zmienna = zmienna + " "
endif

REM: poszukiwanie wartości unikalnych
  for each element in podziel()         'wędrówka po kolejnych danych wejściowych     
    if not(IsEmpty(element) or element = "" or element = zmienna) then   
     'sprawdzaj tylko jeśli element nie jest pusty oraz jest inny od zmiennej
     'UWAGA: W przypadku zakresu danych wejściowych w AOO zaimportowana komórka nigdy nie jest pusta
     'pusta komórka dostaje wartość 0     
      if IsNumeric(element) then   'określenie typu elementu
        element = CDBL(element)      'element jest liczbą
      else
        element = trim(element)      'element jest tekstem, pozbycie się początkowych i końcowych spacji
      endif     
      wynik_od = 0 : wynik_do = ile_w   'zmienne określające przedział wyników do sprawdzenia     
      do while wynik_od <= wynik_do   'warunek porównywania
        i =(wynik_od + wynik_do)\2      'środkowy indeks wyniku, który zostanie porównany z danym elementem
        if  wynik(i) = element then wynik_od = -1 : EXIT DO   'element jest już w tabeli wyników

        if IsNumeric(wynik(i)) or IsNumeric(element) then   'porównanie liczb bądź liczby i tekstu
          warunek = (wynik(i) < element)        
        else			'porównywane wartości są tekstami
          warunek = PorownajTeksty(wynik(i), element)
        endif
       
        if warunek then      'zmniejsz zakres
          wynik_od = i+1    'środek zakresu staje się początkiem
        else
          wynik_do = i-1   'środek zakresu staje się końcem
        endif     
      loop     
     
      if wynik_od > -1 then      'wynik_od to także numer indeksu, na który ma trafić nowy wynik
        ile_w = ile_w+1         'ilość wyników się zwiększyła
        ReDim Preserve wynik(ile_w), niesort(ile_w)
        for i = ile_w to wynik_od+1 step -1   'przesuń wyniki od ostatniego do wyznaczonego
          wynik(i) = wynik(i-1)            'na dane miejsce wstaw wcześniejszy wynik
        next i       
        wynik(wynik_od) = element : niesort(ile_w) = element   'zapisz nowy element
      endif     
    endif
  next

REM: Jaka ma być kolejność wyników?
  select case sort
    Case 0:    'dane mają być nieposortowane
      wynik = niesort   
    'Case 1:    'domyślnie wyniki są sortowane rosnąco
    Case 2:      'sortuj malejąco
      for i=0 to ile_w\2      'odwróć kolejność posortowanych wyników
        element=wynik(i) : wynik(i)=wynik(ile_w-i) : wynik(ile_w-i)=element
      next i
  end Select

REM: Wypisz wyniki:
  if ile_d = -1 then      'w formie połączonego tekstu
    UNIKALNE = join(wynik, zmienna)
  elseif UBound(dane,1) > UBound(dane,2) then   ' pionowa kolumna bo liczba wierszy w danych jest większa od ilości kolumn
   dim wynik2(ile_d,0)as variant
    for i=0 to ile_w         'wyniki od ile_w do ile_d są puste więc można tutaj zakończyć transpozycję wyników
      wynik2(i,0) = wynik(i)
    next i
    UNIKALNE = wynik2
  else
    ReDim Preserve wynik(ile_d)   'poziomy wiersz wyników ma zająć tyle samo komórek co dane wejściowe
    UNIKALNE = wynik
  endif
   
 exit Function
blad:
  UNIKALNE = "Error"
end Function


Function PorownajTeksty(tekst1 as string, tekst2 as string) as boolean
REM Funkcja ta porównuje ze sobą dwa teksty i zwraca informację czy tekst1 jest "mniejszy" od tekstu2
'Const klucz as string = "aAąĄbBcCćĆdDeEęĘfFgGhHiIjJkKlLłŁmMnNńŃoOóÓpPqQrRsSśŚtTuUvVwWxXyYzZźŹżŻ"   'klucz do sortowania
Const klucz as string = "AĄBCĆDEĘFGHIJKLŁMNŃOÓPQRSŚTUVWXYZŹŻ"   'klucz do sortowania
dim litera1$, litera2 as string
dim nrlitery  as integer

  nrlitery = 1
  do while nrlitery > 0
    litera1 = UCase(Mid(tekst1, nrlitery, 1))   'pobieraj kolejne litery (DUŻE LITERY dzięki UCase)
    litera2 = UCase(Mid(tekst2, nrlitery, 1))
    if litera1 = "" or litera2 = "" then   'gdy skończyły się litery
      if litera1 = litera2 then	'oba teksty się skończyły więc są podobne (np: "Ma" i "ma")
        nrlitery = (tekst1 > tekst2)	'sortuj wedug ASCII
      else nrlitery = (len(tekst1) < len(tekst2))	'sortuj według długości
      endif
    elseif litera1 = litera2 then   'litery są takie same - przejdź do następnej litery
      nrlitery = nrlitery + 1
    elseif InStr(klucz,litera1) = 0 or InStr(klucz,litera2) = 0 then   'litery nie ma w kluczu - sortuj wedug ASCII
      nrlitery = (litera1 < litera2)
    else       'porównaj litery według położenia w kluczu
      nrlitery = (InStr(klucz,litera1) < InStr(klucz,litera2))
      'nrlitery = (InStr(1,klucz,litera1,0) < InStr(1,klucz,litera2,0))	'uwzględniaj wielkość liter
    endif
  loop
  PorownajTeksty = (nrlitery = -1)
end Function
EDYTOWANO:
Zmieniłem nieco kod - z części oryginalnego kodu utworzyłem osobną funkcję PorownajTeksty (zmiana estetyczna).
LibreOffice 7.4.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
Awatar użytkownika
Rafkus
Posty: 520
Rejestracja: czw kwie 12, 2018 10:26 pm

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Kolejne dwa znaleziska mogące ulepszyć kod:
  1. Porównywanie wartości zgodnie z ustawieniami regionalnymi można osiągnąć dzięki zastosowaniu Interfejsu XCollator

    Kod: Zaznacz cały

     dim oLocate as  New com.sun.star.lang.Locale	'obiekt reprezentujący określony region geograficzny
      'oLocate = ThisComponent.CharLocale	'pobierz swoją lokalizację/wersję językową
      With oLocate
        .Language = "pl"
        .Country = "PL"
        .Variant = ""
      End With
     dim oCollator as object	'Uzyskaj dostęp do algorytmów sortowania w różnych lokalizacjach  
      oCollator = createUnoService("com.sun.star.i18n.Collator")
      oCollator.loadDefaultCollator(oLocate , 1)	'Wczytaj sortownik dla wybranego regionu

    Powyższy kawałek kodu należy wpisać przed pętlą: "for each element in podziel() ...", a następnie znaleźć w kodzie linijkę:

    Kod: Zaznacz cały

    warunek = PorownajTeksty(wynik(i), element)
    i zastąpić ją tą:
    warunek = (oCollator.compareString(wynik(i), element)=-1)
    W tym przypadku funkcja PorownajTeksty będzie już niepotrzebna.
  2. Kolekcja
    W Basicu można użyć (słabo udokumentowanej) klasy Collection, prawdopodobnie wprowadzonej ze względu na kompatybilność z VB6. Zaimplementowano dla niej następujące metody:
    • Add(Element As Variant, Klucz As String, Optional Przed As Variant, Optional Po As Variant) - dodaj nowy Element o identyfikatorze (Kluczu). Opcjonalnie można powiedzieć PRZED lub PO jakim elemencie ma być on dodany;
    • Remove(Klucz/Indeks As Variant) - usuń element kolekcji o danym Kluczu lub znanym położeniu
    • Count - ile jest elementów
    • Item(Klucz/Indeks As Variant) - odczytaj z kolekcji element o danym Kluczu lub z pozycji
    Przykład:

    Kod: Zaznacz cały

    Sub Kolekcja()
    Dim oKolekcja As New Collection	'Deklaracja kolekcji
    Dim i As Integer
    	oKolekcja.Add("Jeden","AAA")
    	oKolekcja.Add("Pierwszy ","BBB")
    	oKolekcja.Add("Trzeci","CCC")
    REM Do kolekcji były wstawione nowe rekordy, zawsze na końcu zbioru.
    REM Poniżej do kolekcji dodaj nowy rekordy w określonym miejscu
    	'oKolekcja.Add("Drugi","DDD","CCC")		'wstaw Przed "CCC" lub
    	oKolekcja.Add("Drugi","DDD",,"BBB")		'wstaw po "BBB"
    REM teraz usuń wybrany element z kolekcji
    	oKolekcja.Remove("AAA")		'usuń element o danym kluczu
    	'oKolekcja.Remove(1)		'usuń element z określonej pozycji
    REM Wypisz wyniki
    	Print "Ilość elementów kolekcji: " & oKolekcja.Count	'ile jest elementów w kolekcji
    	Print "Pierwszy element kolekcji to: " & oKolekcja.Item(1)
    	Print "Drugi element kolekcji to: " & oKolekcja(2)	'polecenie Item można pominąć
    	Print "Element kolekcji o kluczu ""ccc"" to: " & oKolekcja.Item("ccc")
    	For i = 1 To oKolekcja.Count	'wypisz wszystkie elementy kolekcji	
    		Print oKolekcja(i) & "/";	
    	Next i	
    End Sub
    Moje spostrzeżenia odnośnie używania kolekcji:
    • Pierwszy element kolekcji zaczyna się zawsze od: indeks = 1, indeksy są aktualizowane (przeliczane) na bieżąco;
    • Klucz częściowo nie rozróżnia wielkości liter (ccc=CCC), wielkość znaków jest rozróżniana w polskich literach tj: ą, ć, ę, ł ...
    • W przypadku wywołania według nieistniejącego klucza/indeksu powstanie błąd, można zatem napisać własną funkcję z włączoną obsługą błędów, sprawdzającą czy w kolekcji jest dany klucz.
Funkcja UNILALNE wykorzystująca oba powyższe rozwiązania:

Kod: Zaznacz cały

Function UNIKALNE(dane as variant, optional sort as integer, optional zmienna as string) as variant
REM: Funkcja UNIKALNE: zwraca z pewnego tekstu, komórki lub zakresu danych tylko niepowtarzalne wartości.
REM: Ponadto wynik może zostać automatycznie posortowany
REM: Więcej o funkcji jest tu: https://forum.openoffice.org/pl/forum/viewtopic.php?f=28&p=24335#p24323
 dim oKol as New Collection
 dim podziel(), wynik() as variant
 dim i%, j%, ile_w%, ile_d%, wynik_od%, wynik_do as integer
 dim klucz as string
 dim element as variant, elkol as variant
 dim warunek as boolean 

REM: dane początkowe
' On Local Error GoTo blad
  ile_w = 0		'ilość wyników, narazie ich brak
  If IsMissing(sort) or not (sort =1 or sort =2) then sort = 0   'czy sortować dane: 0-nie, 1-rosnąco, 2-malejąco
  if IsArray(dane) then         'czy dane są tablicą
    If IsMissing(zmienna) then zmienna = ""       'zmienna to wartość do pominięcia
    ile_d =  UBound(dane,1)*UBound(dane,2) - 1   'ilość danych
    podziel = dane
  else
    If IsMissing(zmienna) then zmienna = " "      'zmienna to separator
    ile_d = -1                           'wyniki połącz w jeden tekst
    dane = replace(dane, "  ", " ")            'pozbycie sie podwójnych spacji
    podziel = split(dane, zmienna)
    if zmienna <> " " then zmienna = zmienna + " "
  endif
    
 dim oLocate as  New com.sun.star.lang.Locale	'obiekt reprezentujący określony region geograficzny
  'oLocate = ThisComponent.CharLocale  
  With oLocate
    .Language = "pl"
    .Country = "PL"
    .Variant = ""
  End With
 dim collator as object	'Uzyskaj dostęp do algorytmów sortowania w różnych lokalizacjach  
  collator = createUnoService("com.sun.star.i18n.Collator")
  collator.loadDefaultCollator(oLocate , 1)	'Wczytaj sortownik dla wybranego regionu

REM: poszukiwanie wartości unikalnych
  for each klucz in podziel()         'wędrówka po kolejnych danych wejściowych
    if IsEmpty(klucz) or klucz = "" or klucz = zmienna then
      'jeśli element jest pusty lub  jest taki sam jak zmienna to nic nie rób
      'zostanie wybrany następny element
      'UWAGA: W przypadku zakresu danych wejściowych w AOO zaimportowana komórka nigdy nie jest pusta
      'pusta komórka dostaje wartość 0
    elseif IsCollection(oKol, trim(klucz)) = false  then 
      if IsNumeric(klucz) then   'określenie typu elementu
        element = CDBL(klucz)      'element jest liczbą
        if str(element) <> str(trim(klucz)) then element = trim(klucz)
      else
        element = trim(klucz)      'element jest tekstem, pozbycie się początkowych i końcowych spacji
      endif      
      
      wynik_od = 1 : wynik_do = ile_w	'oKol.Count   'zmienne określające przedział wyników do sprawdzenia     
      do while wynik_od <= wynik_do   'warunek porównywania
        i =(wynik_od + wynik_do)\2      'środkowy indeks wyniku, który zostanie porównany z danym elementem        
        elkol = oKol(i)(0)        
        if VarType(elkol) = 8 and VarType(element) = 8 then 'Porównaj 2 ciągi tekstowe...
          'warunek = PorownajTeksty(elkol, element)
          warunek = (collator.compareString(elkol, element)=-1) '... dla zdanych ustawień regionalnych
        else warunek = (elkol < element)
        endif   
        
        if warunek then      'czy dany element kolekcji jest mniejszy od elementu
          wynik_od = i+1    'środek zakresu staje się początkiem
        else
          wynik_do = i-1   'środek zakresu staje się końcem
        endif     
      loop
      ile_w = ile_w+1		'znaleziono kolejny unikat
      oKol.Add(array(element, ile_w), trim(klucz), wynik_od)     'wynik_od to także numer indeksu, na który ma trafić nowy wynik
    endif
  next		'następny element

REM: Jaka ma być kolejność wyników?
  ReDim  wynik(ile_w-1)  
  for i =1 to ile_w
    select case sort
      Case 0:    	'wyniki mają być nieposortowane
        j = oKol(i)(1)-1	'j to numer znalezienia unikatu
      Case 1:		'wyniki sortowane rosnąco
        j = i-1		'przepisz kolekcję
      Case 2:		'wyniki sortowane malejąco
        j = ile_w-i		'wyniki wpisuj od końca
    end Select
    wynik(j) = oKol(i)(0)
  next
  
  REM: Wypisz wyniki:
  if ile_d = -1 then      'w formie połączonego tekstu  
    UNIKALNE = join(wynik, zmienna)
  elseif UBound(dane,1) > UBound(dane,2) then   ' pionowa kolumna bo liczba wierszy w danych jest większa od ilości kolumn
   dim wynik2(ile_d,0) as variant
    for i=0 to ile_w-1         'wyniki od ile_w do ile_d są puste więc można tutaj zakończyć transpozycję wyników
      wynik2(i,0) = wynik(i)
    next i
    UNIKALNE = wynik2
  else
    ReDim Preserve wynik(ile_d)   'poziomy wiersz wyników ma zająć tyle samo komórek co dane wejściowe
    UNIKALNE = wynik
  endif 
 exit Function
blad:
  UNIKALNE = "Error"
end Function

'************************************************************************************************
Function IsCollection(Kolekcja as new Collection, klucz as string)as boolean
rem Funkcja sprawdza, czy w danej kolekcji istnieje podany klucz
On Error GoTo blad
	Kolekcja(klucz)	
	IsCollection = true
	exit function
blad:
	IsCollection = false
end function
Moje testy dla 1400 danych wejściowych i 450 unikatów wykazało że ten kod jest o jakąś sekundę (wizualnie: o jeden obrót "klepsydry") szybszy od poprzedniej wersji.
LibreOffice 7.4.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
ODPOWIEDZ