Ahoj, jakým způsobem odstraním duplicity v tomto smyslu. Tabulka obsahuje jméno Jirka, Petr, Jirka a potřebuji aby mi zůstalo jen jméno Petr - to jediné bylo unikátní, Duplicitní jméno Jirka chci úplně smazat protože bylo duplicitní. Děkuji
Makro které ponechá jen unikáty, řádky s veškerými duplicitami odstraní
Sub smazNeunikaty 'smaže neunikátní řádky dle hodnot ve sloupci ve kterém je zrovna buňkový kurzor (NENECHÁVÁ PRVNÍ VÝSKYT DUPLIKÁTU jak to dělá Filtr - Bez duplikátů, či doplněk RemoveDuplicates)
dim oDoc, oCont, oList, oVyber, oSloupec, iSloupec&, i&, pAdr(), iPocet&, s$, ps(), ps2(), j%, s2$, iComp%, bVelik%, bDupl as boolean, oRadek, oCur, ss$
oDoc=thisComponent
oCont=oDoc.currentController
oList=oCont.ActiveSheet 'aktivní list
oVyber=oDoc.currentSelection 'aktivní buňka
if oVyber.supportsService("com.sun.star.sheet.SheetCell") then 'jde jen o buňku, nikoliv výběr
iSloupec=oVyber.cellAddress.column 'číslo aktuálního sloupce
oSloupec=oList.getCellRangeByPosition(iSloupec,0,iSloupec,oList.rangeAddress.endRow) 'vybrat celý sloupec
rem dále trochu tý čachrace s názvy buněk abych dostal rozsah ve sloupci od první vyplněné do poslední vyplněné; jde i přes oList.createCursorByRange(oSloupec) a goToEndOfusedArea() jak je to vyřešené v doplňku RemoveDulicates
oVyber=oSloupec.queryContentCells(com.sun.star.sheet.CellFlags.VALUE OR com.sun.star.sheet.CellFlags.DATETIME OR com.sun.star.sheet.CellFlags.STRING OR com.sun.star.sheet.CellFlags.FORMULA) 'poptat buňky co něco obsahují
if oVyber.RangeAddressesAsString="" then 've sloupci není žádný obsah
msgbox "jde o prázdný sloupec",32
exit sub
end if
pAdr=oVyber.RangeAddressesAsString 'adresy obsahových buněk jako řetězec, např. když tam budou mezi obsahem nějaké prázdné řádky tak List1.A1.A2;List1.A4:A5
ps=split(pAdr(0),";") 'v poli nyní ps(0)=List1.A1:A2 a ps(1)=List1.A4:A5
ps2=split(ps(0),":") 'první část sloupce čili List1.A1
s=ps2(0) & ":" 'první část adresy List1.A1:
ss=ps(ubound(ps())) 'poptávka po druhé části adresy
ps2=split(ss,":") 'buď A5 nebo celá adresa (List1.A5) pokud byl poslední řádek osamělý
if ubound(ps2())=0 then ps2=split(ss,".") 'poslední řádek je osamělý (před ním je prázdný), takže jeho adresa je jen List1.A5 takže split podle .
ss=ps2(ubound(ps2())) 'A5
s=s & ss 'požadovaná adresa List1.A1:A5
oVyber=oList.getCellRangeByName(s) 'výběr i s případnými prázdnými řádky mezi daty
oCont.select(oVyber) 'označit výběr
i=msgbox("Rozlišovat velikost písmen při porovnání?",35)
if i=6 then 'rozlišovat velikost písmen při porovnání
bVelik=1
elseif i=7 then 'nerozlišovat velikost písmen
bVelik=0
else 'cancel
goto konec
end if
iPocet=oVyber.rows.count 'počet řádků ve výběru
dim pData(iPocet-1) as variant 'pole s hodnotami ve kterém budu hledat jen unikáty
dim pB(iPocet-1) as boolean 'pole s počtem indexů rovným počtu řádků v prošlém sloupci a ve kterém bude TRUE když nepůjde o unikátní řádek
pData=oVyber.getDataArray() 'hodnoty ze sloupce
for i=lbound(pData()) to ubound(pData())
s=pData(i)(0) 'aktuální prvek
bDupl=false 'bude-li nalezena duplicita tak abych mohl označit i její první výskyt
for j=i+1 to ubound(pData()) 'porovnám aktuální prvek se všemi dalšími prvky v poli
if pB(j)=TRUE then goto sem 'už byl nějaký prvek označen jako duplicitní tak ho nemusím porovnávat
s2=pData(j)(0) 'porovnávaný prvek s aktuálním
if strComp(s,s2,bVelik)=0 then 'jde o stejné prvky
pB(j)=true 'označit jako duplicitní
bDupl=true 'byla označena duplicita
end if
sem:
next j
if bDupl=TRUE then pB(i)=true 'byla-li nalezena duplicita tak označit i její první výskyt
next i
rem odstranění neunikátních řádků
for i=ubound(pB()) to lbound(pB()) step -1 'procházím pole odzadu
if pB(i)=true then 'pro daný řádek je true čili jde o neunikát takže smazat
oRadek=oList.getCellRangeByPosition(0,i,oList.rangeAddress.endColumn,i).getRangeAddress() 'řádek
oList.removeRange(oRadek,com.sun.star.sheet.CellDeleteMode.ROWS) 'smazat řádek
end if
next i
else
msgbox "Nefachá na výběr, jen na celý sloupec ve kterém je zrovna buňkový kurzor",16
end if
konec:
createUnoService("com.sun.star.frame.DispatchHelper").executeDispatch(oDoc.CurrentController.Frame,".uno:Deselect","",0,array()) 'odznačit výběr
End Sub