Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Problém s makrem na odstranění češtiny v Excelové tabulce

Starsi verze Excelu nepodporuji vlastnost HasValidation(Bunka), takze kdyz nemas na listu overovani vkladane hodnoty, pak muzes cast podminky And (Not HasValidation(Bunka)) klidne vypustit. Upravene makro (original je z: http://officir.ic.cz/chipex04/12/excel_vanocni.html) pro ty, co nepochazi z vesnicky nedaleko Toleda (, muzes priradit klavesovou zkratku):

Option Explicit

Sub Odcesti()
Dim Bunka As Range
Dim Oblast As Range
Dim PoleS()
Dim PoleBez()
Dim i As Byte
Application.ScreenUpdating = False

PoleS = Array("Ä", "Á", "È", "Ï", "É", "Ì", "Í", "Å", _
"Ò", "Ö", "Ó", "Ø", "Š", "", "Ü", "Ú", "Ù", "Ý", "Ž", _
"ä", "á", "è", "ï", "é", "ì", "í", "å", "ò", "ö", "ó", _
"ø", "š", "", "ü", "ú", "ù", "ý", "ž")
PoleBez = Array("A", "A", "C", "D", "E", "E", "I", "L", _
"N", "O", "O", "R", "S", "T", "U", "U", "U", "Y", "Z", _
"a", "a", "c", "d", "e", "e", "i", "l", "n", "o", "o", _
"r", "s", "t", "u", "u", "u", "y", "z")

For Each Bunka In ActiveSheet.UsedRange
If (Not Bunka.HasFormula) Then '(And (Not HasValidation(Bunka))
If Oblast Is Nothing Then Set Oblast = Bunka
Set Oblast = Union(Oblast, Bunka)
End If
Next Bunka

For i = 0 To 37
Oblast.Replace What:=PoleS(i), Replacement:=PoleBez(i), _
LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True
Next i

Application.ScreenUpdating = True' v originalu je chybne False

End Sub
P.S.: Bohuzel ve vlozenem kodu dochazi v retezci PoleS k nahrade velkeho a maleho 'r' a 't' s hackem (Ř,ř, Ť,ť) k nahrade nejakym paskvilem, proto si to v editoru VBA oprav (mozna po vlozeni makra do editoru VBA to bude v poradku).

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny