MS Excel

Dobrý den
děkuji za zaslaný vzorec ale pro moji potřebu nestačí.
Na jiných stránkách jsem našel makro, které odstraňuje diakritiku, makro jsem si upravil pro odstraňování diakritiky ve sloupcích H a X viz níže:

Sub diakritika_sloupec_H_X()

Dim Oblast As Range
Dim PoleS()
Dim PoleBez()

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")

Set Oblast = ActiveSheet.Range("H12:H15000", "X12:X15000")
For i = 0 To 37
Oblast.Replace What:=PoleS(i), Replacement:=PoleBez(i), _
LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True
Next i

End Sub

Potřebuji toto makro ale upravit tak, aby se diakritika neodstraňovala, ale aby se buňky, které obsahují diakritiku, označily např. žlutou barvou.citovat

Ja by som to videl nejako takto. Je to ale špecializované na jednostĺpcové oblasti, tak ako ste chcel.
Sub Oznac_diakritiku_v_oblasti(Oblast As Range)
Dim USlova, USpolu As String, Nahrad() As String, i As Long, UZnak As String * 1, poz As Long, Dlzka As Long, Pokracuj As Boolean, RNG As Range, Riadkov As Long
Const ODDEL = "•#$" 'Jednoznačný oddeľovač buniek

With Oblast
.ClearFormats 'Vymaže doterajší formát
Riadkov = .Cells(.Rows.Count).End(xlUp).Row - .Row + 1 'Budú sa skúmať iba vyplnené riadky
Select Case Riadkov
Case Is < 0: Exit Sub
Case Is > 1: USpolu = UCase(Join(WorksheetFunction.Transpose(Oblast), ODDEL)) 'Spojenie a prevod na UCASE
Case 1: USpolu = UCase(.Cells(1))
End Select

Nahrad = Split("A•B•C•D•E•F•G•H•I•J•K•L•M•N•O•P•Q•R•S•T•U•V•W•X•Y•Z", "•") 'Pre niektoré prípady bude možno lepšie vyradiť aj iné znaky, viď nižšie. Ale niekedy to je zase kontrproduktívne.
'Nahrad = Split("A•B•C•D•E•F•G•H•I•J•K•L•M•N•O•P•Q•R•S•T•U•V•W•X•Y•Z•0•1•2•3•4•5•6•7•8•9•+•-•*•/•=•?•!•(•)•.•_•:•;•,", "•")
For i = 0 To UBound(Nahrad) 'Vynechanie znakov
If Not InStr(USpolu, Nahrad(i)) Then USpolu = Replace(USpolu, Nahrad(i), vbNullString)
Next i
USlova = Split(USpolu, ODDEL) 'Rozdeľ naspäť prečistené

For i = 0 To UBound(USlova)
Dlzka = Len(USlova(i)) 'Zistí dĺžku reťazca, pre ukončenie

If Dlzka > 0 Then
poz = 1
Pokracuj = True

While Pokracuj
UZnak = Mid$(USlova(i), poz, 1) 'Po jednom znaku kontroluj
If StrComp(UZnak, LCase(UZnak), vbBinaryCompare) = 0 Then 'ak nenájde rozdiel medzi UCASE a LCASE znaku, nieje to určite diakritika, lebo ostatné písmená sme vyradili už skôr, a je to nejaký iný znak
poz = poz + 1
If poz > Dlzka Then Pokracuj = False 'Ak bolo posledné písmeno, ukonči
Else
Pokracuj = False
If RNG Is Nothing Then Set RNG = .Cells(i + 1) Else Set RNG = Union(RNG, .Cells(i + 1)) 'a ak nájde rozdiel medzi UCASE a LCASE znaku, je to určite diakritika, a teda priraď do výslednej oblasti
End If
Wend

End If
Next i
End With

If Not RNG Is Nothing Then RNG.Interior.Color = vbYellow 'Vyfarbiť
End Sub

Sub Oznac()
With ThisWorkbook.Worksheets("Hárok1")
Oznac_diakritiku_v_oblasti .Range("H12:H15000") '1. jednostĺpcová oblasť
Oznac_diakritiku_v_oblasti .Range("X12:X15000") '2. jednostĺpcová oblasť
End With
End Sub

EDIT:
Prípadne to "jadro pudla" - While->Wend, vymeniť za asi o 2% rýchlejší variant
While Pokracuj
UZnak = Mid$(USlova(i), poz, 1) 'Po jednom znaku kontroluj
Select Case True
Case Asc(UZnak) < 128: poz = poz + 1: Pokracuj = poz <= Dlzka 'Kontrola iba znakov >127, Ak bolo posledné písmeno, ukonči
Case StrComp(UZnak, LCase(UZnak), vbBinaryCompare) = 0: poz = poz + 1: Pokracuj = poz <= Dlzka 'ak nenájde rozdiel medzi UCASE a LCASE znaku, nieje to určite diakritika, lebo ostatné písmená sme vyradili už skôr, a je to nejaký iný znak, Ak bolo posledné písmeno, ukonči
Case Else: Pokracuj = False: If RNG Is Nothing Then Set RNG = .Cells(i + 1) Else Set RNG = Union(RNG, .Cells(i + 1)) 'a ak nájde rozdiel medzi UCASE a LCASE znaku, je to určite diakritika, a teda priraď do výslednej oblasti
End Select
Wendcitovat

Aha. No ak je to tak, tak potom nie použiť StrComp(), ale definovať si reťazec českých znakov UCASE(), a použiť InStr(). Ale zatiaľ to prerábať nebudem, počkám na vyjadrenie Raptora-22.citovat