Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 29. 3. 2016 14:27:29

idp
Člen
Registrace: 18. 9. 2015
Příspěvků: 16

Najít nejpodobnější výraz - VYŘEŠENO

Dobrý den, obracím se na vás s prosbou o pomoc, mám dvě tabulky:

Tabulka 1          Tabulka 2
P.Novak                  Petr Novák|123456789|petr.d@neco.cz       
Dvorak J.                Jan Dvořák|234567891|jan@neco.cz 
Karel N.                 Karel Nový|2345678|k.novy@neco.cz
Petr N.
Dvorak J.
Novak Petr
K. Nový



Potřboval bych ke každému záznamu v tabulce A přidat sloupce B a C z tabulky 2, z nejvhodnějšího řádku. Jedná se jen o orientační přehled, takže raději to zpracovat automaticky i za cenu možné chyby.

Jde toto nějak udělat v OO Calc? Děkuji

Editoval idp (30. 3. 2016 10:24:33)

Offline

#2 29. 3. 2016 14:43:49

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 2,678

Re: Najít nejpodobnější výraz - VYŘEŠENO

Nejlépe asi pomocí "konsolidace dat" - je to políčko s roletkou výběru.


     Pokud byste ale chtěl jednotný vzorec tak například "VLOOKUP".
V tabulce 1 vedle jména =VLOKUP(Jméno tabulka 1;úsek Tabulky 2 (3 sloupce) - voláme nejprve 2. sloupec). Následně znovu ale voláme třetí sloupec.


     Takhle se to popisuje špatně postněte sem vzor.


PS také je možní makro podle toho co preferujete. Makro lze postavit na tlačítko, nebo klávesovou zkratku a spustí se nad libovolně dlouhým obsahem.

Editoval neutr (29. 3. 2016 14:45:29)


Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte tak orientaci na fóru při vyhledávání řešení problémů
JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#3 29. 3. 2016 16:12:23

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 790

Re: Najít nejpodobnější výraz - VYŘEŠENO

Trochu problém. Zejména míchání jmen s diakritikou a bez diakritiky.

Nejprve co hledat:
V možnostech povolte regulární výrazy ve vzorcích.

Předpokládám, že tabulka 1 je ve sloupci A od řádku 1
a Tabulka 2 od řádku 20.

B2: =SEARCH("[:alpha:]{3,}";A2)    ' najde počátek prvního slova s nejméně 3 znaky
C2: =MID(A2;B2;10000)        ' slovo + něco za ním
D2: =SEARCH("[ \.]|\b";C2)   ' ve zbytku hledá pozici mezery nebo tečky, další znaky lze doplnit
E2: =LEFT(C2;D2-1)         ' vybráno slovo s min 3 znaky
F2: =VLOOKUP(".*"&E2&".*";$A$21:$C$23;2;0)    ' hledá v tabulce 2 záznam, který obsahuje nalezené slovo.

B2:F2 lze zapsat v jednom vzorci:

=VLOOKUP(".*"&LEFT(MID(A2;SEARCH("[:alpha:]{3,}";A2);10000);SEARCH("[ \.]|\b";MID(A2;SEARCH("[:alpha:]{3,}";A2);10000))-1)&".*";$A$21:$C$23;2;0)

Diakritika vadí. Asi by bylo vhodné ji odstranit, buď mimo calc nebo makrem. Případně vzorcem, ale to není moc efektivní.

Offline

#4 29. 3. 2016 19:00:03

idp
Člen
Registrace: 18. 9. 2015
Příspěvků: 16

Re: Najít nejpodobnější výraz - VYŘEŠENO

děkuji, bez diakritiky to už funguje, bohužel se však nějak propojí např. adam dvořák s adam novák - u obou se vloží stejný řetězec, když jsem zkoušel rozšířit E2, tak to nepomohlo, když jsem to tam dal 2x a jen posunuté tak se to celé rozhodilo

Offline

#5 29. 3. 2016 19:06:56

idp
Člen
Registrace: 18. 9. 2015
Příspěvků: 16

Re: Najít nejpodobnější výraz - VYŘEŠENO

vlastně ideální by bylo, aby se třeba hledaly 3 slova delší než 3 znaky, kdyby se nenašlo tak 2 a pak klidně jedno, zpřesnilo by to výsledek a zároveň nenechalo zbytečně prázdné řádky

Offline

#6 29. 3. 2016 19:14:43

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 2,678

Re: Najít nejpodobnější výraz - VYŘEŠENO

Jako vyhledávací parametr ve druhé tabulce musíte dát stejnou sekvenci jakou hledáte. Tam co popisujete půjde o řazení. Jde o poslední číslo - v popisu vzorce je uvedeno, že pokud je uvedena "Pravda", nebo není uvedena musí to být seznam vzestupně řezený.
     Takže se pokuste bud tabulku2 ve hledávacím parametru seředit vzestupně, nebo otestujte na posledním čísle "0", "1". Jde o to, že TRUE je obvykle jednička, ale také jindy "-1".


     Nejde ani tak o interpunkci VLOOKUP (HLOOKUP, LOOKUP) vyhledají přesný výraz. Ty nepřesnosti se dají řešit vyhledáváním jak uvádí "lp.", ale ty regulární výrazy musíte dobře otestovat.


Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte tak orientaci na fóru při vyhledávání řešení problémů
JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#7 29. 3. 2016 20:15:31

ludviktrnka
Člen
Registrace: 9. 7. 2009
Příspěvků: 520

Re: Najít nejpodobnější výraz - VYŘEŠENO

mám trošku variaci na řešení dle lp.:
nejdřív je tedy potřeba odstranit diaktiriku. Doporučuji nahrát novou funkci. Může se hodit i jindy.

Function removediak (vstup as string)
	Dim bezdiak as string
	Dim delka as integer
	dim pozice as integer
	
	pismenasdiak =   array("ě","š","č","ř","ž","ý","á","í","é","ú","ů","ä","ë","ó","ö","ü","ď","ť","ň","Ě","Š","Č","Ř","Ž","Ý","Á","Í","É","Ú","Ů","Ä","Ë","Ó","Ö","Ü","Ď","Ť","Ň")
	pismenabezdiak = array("e","s","c","r","z","y","a","i","e","u","u","a","e","o","o","u","d","t","n","E","S","C","R","Z","Y","A","I","E","U","U","A","E","O","O","U","D","T","N")
	
	bezdiak = vstup
	delka = len(bezdiak)
			
	For i = lbound(pismenasdiak()) to ubound(pismenasdiak())
		Do
			pozice = InStr(1 , bezdiak , pismenasdiak(i) , 0) 'prohledává stále od prvního znaku, určeno pro krátké texty
			if pozice <> 0 then
		   		bezdiak = left(bezdiak, pozice - 1) + pismenabezdiak(i) + right(bezdiak, delka - pozice)
			end if
		Loop While pozice <> 0
	Next i
	removediak = bezdiak
End Function

potom
B1 = REMOVEDIAK(A1)
v C odstrníme tečku
C1 = SUBSTITUTE(B1;".";"")
v D zjistím polohu mezery
D1 = SEARCH("[:space:]";C1)
v E si vypíšu první část jména
E1 = LEFT(C1;D1-1)
v F drouhou část jména
F1 = MID(C1;D1+1;1000)
a v G vyhledávám v obou pořadí jmen:
G1 = ifna(VLOOKUP(".*"&E1&".*"&F1&".*";$A$20:$B$22;2;0);VLOOKUP(".*"&F1&".*"&E1&".*";$A$20:$B$22;2;0))

a ještě zlepšovák:
C1 = TRIM(SUBSTITUTE(B1;".";" "))


Nepříjemná je ovšem absence jakékoli mezery. Resp. na větším vzorku dat by se to asi mělo ještě ladit.

A samozřejmě na zákaldní soubor jmen (čili zde A20:A22 je zapotřebí též použít odstraňovač diakritiky.


a ještě zlepšováček:
D1 = IF(ISNUMBER(SEARCH("[:space:]";C1));SEARCH("[:space:]";C1);LEN(C1)+1)
pro případ že je zadáno pouze příjmení bez dalších iniciálů
edit: lepší takto: D1 = SEARCH("[:space:]|\b";B1)

Editoval ludviktrnka (30. 3. 2016 07:15:20)


LibreOffice 5.2.2.2

Offline

#8 30. 3. 2016 04:00:37

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 2,678

Re: Najít nejpodobnější výraz - VYŘEŠENO

Tady se musí vzít v úvahu značná vágnost dotazu. Proto bych raději viděl jak vypadají ostrá data.


      Co myslím tou vágností dotazu? Zejména případy kdy je vyhledávacím kriteriem křestní jméno plus iniciála příjmení. Navíc autor uvádí variantu se záměnou pozice křestního jména a příjmení. Mimo toho uvádí varianty s mezerou a bez mezery, nebo i plné jméno a příjmení, ale bez interpunkce.
      Snad bude pochopitelnější tohle dotazování s náhledem sem Přehled příjmení a křestních jmen v ČR.



      K úplné vágnosti už schází jen zadání také iniciál jména a příjmení v obou variantách řazení a vyjádření "Case Sensitive" = celkem 8 variant.


      Hledání takto nepřesných výrazů nutně vede k vyjádření mnoha alternativ čehož si je autor velmi dobře vědom když v prvním příspěvku uvádí:  Jedná se jen o orientační přehled, takže raději to zpracovat automaticky i za cenu možné chyby..


      Ovšem v zápětí - příspěvek #4 děkuji, bez diakritiky to už funguje, bohužel se však nějak propojí např. adam dvořák s adam novák.


      Takže je vidět, že o nepřesný odhad nejde. Musí být co nejpřesnější a chyba může nastat jen z redundace stejného zadání pro různá jména. Například Karel Nový - Karel Novotný, Nebo třeba Norbert Karel. Tedy Karel N, N. Karel a nebo tam kde se příjmení shoduje s křestnímí jmény.
      Nechci ani domýšlet komu a na co by to bylo dobré když výstup bez interpunkce je nejspíš dán jako Log zahraničního serveru. Nicméně může to být pozitivní snaha v rámci "pomáhat a chránit".
      Proto spíš doufám, že jde o nějaký prastarý intranet, nebo server a tazatel je oprávněným pracovníkem provozovatele takového intranetu (serveru). Podobných "libových" důvodů může být více.
      Z tohoto důvodu jsem také odpovídal. Je totiž docela logické, že uzavřené a tím pádem omezené sítě mají jen končený počet uživatelů v řádu několika desítek, nanejvýš stovek jmen.


      Proto lze do tabulky 2 zadat všechny vyhledávací alternativy jednoho jména, seřadit vzestupně a hledat jen Pomocí VLOOKUP. To je tedy řešení pro celkem malý počet případných jmen.


      Obecnější vyhledávání lze udělat také - ale už jen pomocí nekolika maker, která postupně projedou každé jméno z pohledu obsahu a kombinace znaků. Všechny nálezy podobností se mohou vyhodnotit a vrátit jediný výsledek - ten nejpravděpodobnější. Následně by tam měla být informace o celkovém počtu možných alternativ, nebo i s % relevantnosti.


      Snad jsem situaci popsal dost podrobně. Domnívám se, že na tohle může správně reagovat jen tazatel. Předem říkám, že bez omezení počtu jmen, vyjádření přijatelných modifikací nebo alespoň úpravě vstupní tabulky na menší počet alternativ to vzrocem bude dávat jen výsledky jaké uvádí "lp." - lepší to vzorcem být nemůže.


Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte tak orientaci na fóru při vyhledávání řešení problémů
JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#9 30. 3. 2016 10:23:40

idp
Člen
Registrace: 18. 9. 2015
Příspěvků: 16

Re: Najít nejpodobnější výraz - VYŘEŠENO

Děkuji všem za pomoc, vyřešeno.

Offline

#10 30. 3. 2016 11:25:13

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 790

Re: Najít nejpodobnější výraz - VYŘEŠENO

Zkusil jsem to ještě makrem. Spíše pro inspiraci, nejsou ošetřeny některé stavy.

Funkce IxDobraShoda vrátí index v poli, které se shoduje v největším počtu slov. Delší slovo má větší váhu, pokud je shod více, bere se první. Pokud není nic nalezenou, lze třetím parametrem definovat vrácenou hodnotu.

=IXDOBRASHODA(A2;$A$21:$A$23)

Vrátí 1

(Dovolil jsem si upravit funkci removediak)

' Vrací index nelepší shody. Delší slovo má větší váhu.
Function IxDobraShoda(S as String, Pole() as Variant, Optional Default as variant) as Variant
Dim aSlova() as Variant
Dim aTexty() as Variant

Dim i as Long, j as Long
Dim PracText as String
Dim Vaha as Long 	
Dim Shoda as Long, MaxShoda as Long

	aSlova = Slova(RemoveDiak(S))

	If LBound(Pole)	= UBound(Pole) Then ' Řádek
		ReDim aTexty(LBound(Pole,2) to UBound(Pole,2))

		i = LBound(Pole)
		For j = LBound(Pole,2) to UBound(Pole,2)
			aTexty(j) = Pole(i, j)
		Next	
	Else	                            ' Sloupec
		ReDim aTexty(LBound(Pole) to UBound(Pole))

		j = LBound(Pole, 2)
		For i = LBound(Pole, 1) to UBound(Pole, 1)
			aTexty(i) = Pole(i, j)
		Next	
	End If  

	' Můžeme hledat
	MaxShoda = 0
	If IsMissing(Default) Then 
		IxDobraShoda = -1
	Else
		IxDobraShoda = Default
	End If
	
	For i = LBound(aTexty) to UBound(aTexty)
		PracText = RemoveDiak(RemoveZnaky(aTexty(i)))

		Vaha = UBound(aSlova) - LBound(aSlova)
		Shoda = 0
		For j = LBound(aSlova) to UBound(aSlova)
			If InStr(1 , PracText , aSlova(j)) > 0 Then Shoda = Shoda + 2 ^ Vaha
			Vaha = Vaha - 1
		Next j
		If MaxShoda < Shoda Then 
			IxDobraShoda = i
			MaxShoda = Shoda
		End If
	Next i	
End Function

' Setříděný seznam slov
Function Slova(S as String, Optional Pocet as Integer) as Variant 
  	Dim aSlova(0 to 0) As Variant
	Dim i as Long, j as Long, n as Long, b as Long     
	Dim Temp as String

	' Zbavím se teček, ...
	aSlova = Split(RemoveZnaky(S), " ")

	b = LBound(aSlova): n = UBound(aSlova)
	
	For i = b To n - 1   ' bubliny, předpokládám malý počet slov
    	For j = i + 1 To n
      		If Len(aSlova(i)) < Len(aSlova(j)) Then
        	Temp = aSlova(i)
        	aSlova(i) = aSlova(j)
        	aSlova(j) = Temp
      	End If
    	Next j
  	Next i

	If IsMissing(Pocet) Then Pocet = 3
	If n - b > (Pocet - 1) Then n = (Pocet - 1) + b
	
	ReDim Preserve aSlova(b to n) As Variant
	Slova = aSlova
End Function

Function RemoveDiak (vstup as string)
	Dim i as integer
	
	pismenasdiak =   array("ě","š","č","ř","ž","ý","á","í","é","ú","ů","ä","ë","ó","ö","ü","ď","ť","ň","Ě","Š","Č","Ř","Ž","Ý","Á","Í","É","Ú","Ů","Ä","Ë","Ó","Ö","Ü","Ď","Ť","Ň")
	pismenabezdiak = array("e","s","c","r","z","y","a","i","e","u","u","a","e","o","o","u","d","t","n","E","S","C","R","Z","Y","A","I","E","U","U","A","E","O","O","U","D","T","N")
	
	For i = lbound(pismenasdiak) to ubound(pismenasdiak)
			vstup = Replace(vstup, pismenasdiak(i), pismenabezdiak(i))
	Next i
	RemoveDiak = vstup
End Function

' Smaže zadané znaky
Function RemoveZnaky (Vstup as string, Optional Smazat as String) as String
	Dim i as integer
	
	If IsMissing(Smazat) Then Smazat = ".,?!:)("
	
	For i = 1 to Len(Smazat)
		Vstup = Replace(Vstup, Mid(Smazat, i, 1), " ")
	Next i
	Vstup = Trim(Vstup)
	RemoveZnaky = Vstup
End Function

Offline

#11 30. 3. 2016 11:34:17

ludviktrnka
Člen
Registrace: 9. 7. 2009
Příspěvků: 520

Re: Najít nejpodobnější výraz - VYŘEŠENO

Nádhera. Spousta inspirace.


LibreOffice 5.2.2.2

Offline

Zápatí