Vlastní funkce pro odstranění diaktritiky

Upozornění – tenhle článek se týká VBA, které už je trochu zastaralé. Pokud chcete diakritiku odebírat v Power Query, bude vás zajímat spíše tento návod.

Při práci s tabulkami se občas dostaneme do situace, kdy příliš neoceňujeme úsilí Jana Husa o zavedení znaků s českou diakritikou.

Tento článek obsahuje kód pro vytvoření vlastní funkce, která nám umožní se těchto znaků zbavit. Vložte ho do modulu v editoru VBA, čímž vytvoříte vlastní funkci.

Kód není můj, nicméně už léta se potuluje na webu a nejsem schopný dohledat původní zdroj. Moje jsou pouze doplněné komentáře.

Function bezdiakritiky(source As Variant) As String

'Načtení seznamu českých znaků a jejich ekvivalentů bez interpunkce
Const cz As String = "áÁčČďĎéÉěĚíÍňŇóÓřŘšŠťŤúÚůŮýÝžŽ"
Const en As String = "aAcCdDeEeEiInNoOrRsStTuUuUyYzZ"

'Načtení proměnných použitých dále v textu
Dim TmpS As String
Dim OutS As String
Dim I As Integer

'"Vyprázdnění" proměnné
OutS = ""

'Pokud by byl zdroj prázdný, tak není co řešit - bude prázdný i výstup
If IsNull(source) Or source = "" Then
 bezdiakritiky = ""
 
'V jiném případě se začne převádět
Else

'Cyklus udělá tolik kroků, kolik je ve zdroji písmen
 For I = 1 To Len(source)
 
 'Do proměnné TmpS se načte první (a pak další) český znak
 TmpS = Mid(source, I, 1)
 'InStr je funkce, která hledá v textu určitý znak a vrací jeho polohu (podobně jako NAJÍT v tabulce). Nejprve zjistí, jestli tam ůvbec je, a pokud ano, vytvoří nový "opravený" řetězec
 If InStr(1, cz, TmpS, vbBinaryCompare) > 0 Then TmpS = Mid(en, InStr(1, cz, TmpS, vbBinaryCompare), 1)
 OutS = OutS & TmpS
 Next I
 'Výsledek se uloží do výstupu
 bezdiakritiky = OutS
End If
End Function