Páči sa.
Vrátane 3 spôsobov volania (malé, veľké, bez zmeny veľkosti)
!!! Vo fn je aj odstránenie medzier, lomiek atď.
Treba si upraviť podľa potreby.

"Opucuje" diakritiku v označenej oblasti.


Sub aDiakritika_RemoveL()
Call aDiakritika_Remove_x("L")
End Sub

Sub aDiakritika_RemoveU()
Call aDiakritika_Remove_x("U")
End Sub

Sub aDiakritika_Remove()
Call aDiakritika_Remove_x
End Sub

Sub aDiakritika_Remove_x(Optional xCase As String)

' ReplaZnakyPrePolia Macro
' Macro recorded 18.2.2006 by PC-PROG
'
Dim xCo(), xZa(), xRng As Range, c As Range
Dim i As Long

xCo = Array("ý", "ú", "í", "é", "ě", "á", "ä", "ó", "ô", "č", "ď", "ľ", "ĺ", "ň", "ř", "ŕ", "š", "ť", "ž", " ", ".", "-", ")", "(", "]", "[", ",", "/", "\")
xZa = Array("y", "u", "i", "e", "e", "a", "a", "o", "o", "c", "d", "l", "l", "n", "r", "r", "s", "t", "z", "_", "_", "_", "", "", "", "", "", "_", "_")

Set xRng = Selection

For i = LBound(xCo) To UBound(xCo)
xRng.Replace What:=xCo(i), Replacement:=xZa(i), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

xRng.Replace What:=UCase(xCo(i)), Replacement:=UCase(xZa(i)), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Next i

If xCase <> "" Then
For Each c In xRng
c.Value = IIf(xCase = "U", UCase(c.Text), LCase(c.Text))
Next c
End If

Set xRng = Nothing
End Sub


Palo

[QUOTE=PaloPa;1818657]Páči sa.
Vrátane 3 spôsobov volania (malé, veľké, bez zmeny veľkosti)
!!! Vo fn je aj odstránenie medzier, lomiek atď.
Treba si upraviť podľa potreby.

"Opucuje" diakritiku v označenej oblasti.
--------------------------------------------------------------
Ahoj.

Prebehlo mi to pekne aj na malé aj veľké písmená iba mi do oddeľuje slová podčiarnikom. Sorry v makrách sa nevyznáznám takže upraviť si ho neviem.
Evika

príklad : operácia sivého zákalu s implantáciou umelej vnútroočnej šošovky
operacia_siveho_zakalu_s_implantaciou_umelej_vnutr oocnej_sosovky

... iba mi do oddeľuje slová podčiarnikom...

Ahoj Evi,

Vymeň si príslušné dva riadky za tie, ktoré vidíš nižšie:

xCo = Array("ý", "ú", "í", "é", "ě", "á", "ä", "ó", "ô", "č", "ď", "ľ", "ĺ", "ň", "ř", "ŕ", "š", "ť", "ž")
xZa = Array("y", "u", "i", "e", "e", "a", "a", "o", "o", "c", "d", "l", "l", "n", "r", "r", "s", "t", "z")
Palo

Ahoj Evi,

Vymeň si príslušné dva riadky za tie, ktoré vidíš nižšie:

xCo = Array("ý", "ú", "í", "é", "ě", "á", "ä", "ó", "ô", "č", "ď", "ľ", "ĺ", "ň", "ř", "ŕ", "š", "ť", "ž")
xZa = Array("y", "u", "i", "e", "e", "a", "a", "o", "o", "c", "d", "l", "l", "n", "r", "r", "s", "t", "z")
Palo

Vďaka ja som ale truhlík ;). Toto som si ozaj mohla všimnúť. Pomohol si mi :):):)

Aj toto by malo fungovať.


Function textBezdia(textSdia As String)
For i = 1 To Len(textSdia)
x = Asc(Mid(textSdia, i, 1))
Select Case x
Case 165, 193, 194, 195, 196: y = 65
Case 198, 199, 200: y = 67
Case 207, 208: y = 68
Case 201, 202, 203, 204: y = 69
Case 205, 206: y = 73
Case 163, 188, 197: y = 76
Case 209, 210: y = 78
Case 211, 212, 213, 214: y = 79
Case 192, 216: y = 82
Case 138, 140, 170: y = 83
Case 141, 222: y = 84
Case 217, 218, 219, 220: y = 85
Case 221: y = 89
Case 142, 143, 175: y = 90
Case 185, 225, 226, 227, 228: y = 97
Case 230, 231, 232: y = 99
Case 239, 240: y = 100
Case 233, 234, 235, 236: y = 101
Case 237, 238: y = 105
Case 190, 229: y = 108
Case 241, 242: y = 110
Case 243, 244, 245, 246: y = 111
Case 224, 248: y = 114
Case 154, 156, 186, 223: y = 115
Case 157, 254: y = 116
Case 249, 250, 251, 252: y = 117
Case 253: y = 121
Case 158, 159, 191: y = 122
Case Else: y = x
End Select
textBezdia = textBezdia & Chr(y)
Next i

End Function