Jestliže jste narazili na problém jak rychle odstranit diakritiku z libovolného textu, tak zde mám rychlé řešení. Vytvoříme si vlastní funkci v Excelu.
Otevřete si Microsoft Excel – nabídka Vývojář – Visual Basic. Otevře se program Microsoft Visual Basic, zde dejte pravé tlačítko myši na ThisWorkbook (je to vlevo) – Insert – Module. Otevře se Sešit1 do kterého překopírujte tento skript:
Function diakritika(source As Variant) As String
Const cz As String = "áÁčČďĎéÉěĚíÍňŇóÓřŘšŠťŤúÚůŮýÝžŽ"
Const en As String = "aAcCdDeEeEiInNoOrRsStTuUuUyYzZ"
Dim TmpS As String
Dim OutS As String
Dim I As Integer
OutS = ""
If IsNull(source) Or source = "" Then
diakritika = ""
Else
For I = 1 To Len(source)
TmpS = Mid(source, I, 1)
If InStr(1, cz, TmpS, vbBinaryCompare) > 0 Then TmpS = Mid(en, InStr(1, cz, TmpS, vbBinaryCompare), 1)
OutS = OutS & TmpS
Next I
diakritika = OutS
End If
End Function
Poté zvolte nabídku Debug – Compile VBAProject. To je vše. V excelu pak funkci použijete např.:
diakritika(F6)
Nejsem autorem skriptu, pouze jsem upravil název. Zdroj zde. Výborná věc, která mi už párkrát ušetřila čas.:-)
Existuje způsob, jak modul implementovat tak, aby zůstal uložen mezi funkcemi v Excelu i pro příští spuštění a nemusel jsem ho vytvářet pokaždé, když potřebuji diakritiku odstranit? Díky.
nepis kokote nikoho to nezajima
Zajímalo by mě, jak tu samotnou funkci následně spustit a text upravit.
Ahoj, kdyby měl někdo zájem o alternativu, resp. o přepisování veškeré diakritiky rovnou bez použití funkce, ale automaticky spouštěného makra při každé změně v jakékoliv buňce, napsal jsem krátké makro, které stačí vložit do sheetu ve VBA editoru (ne do modulu). Při jakémkoliv nakopírování, vepsání textu s diakritikou dojde okamžitě k přepsání.
Private Sub Worksheet_Change(ByVal Target As Range)
Const cz As String = „áÁčČďĎéÉěĚíÍňŇóÓřŘšŠťŤúÚůŮýÝžŽ“
Const en As String = „aAcCdDeEeEiInNoOrRsStTuUuUyYzZ“
Dim i As Integer
Dim Lc As Long
Lc = 30
For i = 1 To Lc
Target.Replace Mid(cz, i, 1), Mid(en, i, 1)
Next
End Sub
Menší update příspěvku…předchozí verze nebyla case sensitive…tudíž pracovala špatně.
Private Sub Worksheet_Change(ByVal Target As Range)
Const cz As String = „áÁčČďĎéÉěĚíÍňŇóÓřŘšŠťŤúÚůŮýÝžŽ“
Const en As String = „aAcCdDeEeEiInNoOrRsStTuUuUyYzZ“
Dim i As Integer
Dim Lc As Long
Dim OrigLetter As String
Dim x As Variant
Dim CzLetter As String
Dim EnLetter As String
Dim NewWord As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Lc = 30
OrigLetter = „“
For x = 1 To Len(Target.Value)
OrigLetter = Mid(Target.Value, x, 1)
For i = 1 To Lc
CzLetter = Mid(cz, i, 1)
EnLetter = Mid(en, i, 1)
If OrigLetter = CzLetter Then
OrigLetter = EnLetter
End If
Next i
NewWord = NewWord & OrigLetter
Next x
Target.Value = NewWord
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Tento skript jsem docela dlouho s úspěchem používal, ovšem po přeinstalaci Windows vidím teď ve VBA znaky „áÁčČďĎéÉěĚíÍľĽňŇóÓřŘšŠťŤúÚůŮýÝžŽ “ ve VBA jako „“áÁèÈïÏéÉìÌí;¼òÒóÓøØšŠùÙúÚůŮýÝžŽ“. Určitě je to nastavením jazyků v systému, ale bohužel netuším které nastavení… 🙁
Thanks for the post. awesome!
Ďakujem
Zvlastni, Č. Ů to nechává, nechápui proč …. na office 2013
Super funguje a prosim jak tuto funkci ulozim do excelu, abych ji nemusel devat do kazdeho souboru zvlast
Nemam to odzkousene, ale melo by to fungovat pres tzv. vytvoreni doplnku:
http://www.rjurecek.cz/excel/navody-a-postupy-pro-praci-v-excelu/vytvareni-doplnku/
nefunguje ti to – musíš mít všechny uvozovky „nahoře“
NJ WordPress mi je predelal..:-) Uz jsem upravill, dekuju..