MS Excel

Zdravím,

mám kód:
Dim myRange As Range, E()
Dim substr As String, endstr As String
Dim txtColor As Long, x As Long, y As Long, Pos As Long, endPos As Long, startPos As Long, LenEndStr As Long

Set myRange = Worksheets(Active).Range("E16:M138")
If myRange.Cells.Count > 1 Then E = myRange.Value Else ReDim E(1, 1): E(1, 1) = myRange.Value

substr = "Nezapsané prostoje-"
endstr = "min"
txtColor = 3
LenEndStr = Len(endstr)

For y = 1 To UBound(E, 1)
For x = 1 To UBound(E, 2)
Pos = 1
Do
startPos = InStr(Pos, E(y, x), substr, vbTextCompare)
If startPos <> 0 Then
endPos = InStr(startPos, E(y, x), endstr, vbTextCompare)
If endPos <> 0 Then
myRange.Cells(y, x).Characters(Start:=startPos, Length:=endPos - startPos + LenEndStr).Font.ColorIndex = txtColor
Pos = endPos + LenEndStr
End If
End If
Loop Until startPos = 0 Or endPos = 0
Next x
Next y

obarvuje mi to správně, ale chtěl bych přidat další "substr" aby mi to obarvovalo další častí kódu, ale jiné např. "substr2 = "Přechod" pod jinou barvou - např. txtColor2 = 3

Šlo by to nějak zkrátit ten kód, abych nemusel mít 2x za sebou stejný kód a jen upravené proměnné? těch barev a textu tam mam více.

Zaslat odpověď >

elninoslov(12.1.2025 9:58)#057138

Pr.

Příloha: zip

57138_vyfarbi.zip (19kB, staženo 3x)

citovat

Fantasyk(12.1.2025 19:03)#057139

elninoslov napsal/a:

Pr.Příloha: 57138_vyfarbi.zip (19kB, staženo 2x)

Díky za vytvoření excelu.
Přebarví mi to jen červeně ten Nezapsaný prostoj, ale přechod jinou barvou to nepřebarví

EDIT:
už jsem na to přišel neumí to diakritiku.
To už si nějak upravím..

Děkuji moc krátcitovat

elninoslov(12.1.2025 20:35)#057141

??? Chcete povedať, že slovo "Přechod" kvôli "ř" nenájde? Mne to normálne funguje. Aký je to Office? Verzia, jazyková mutácia, jazyk systému?
V prílohe výsledok:

Příloha: zip

57141_vyfarbioverenie.zip (19kB, staženo 1x)

citovat

Téma: Přebarvení části textu pomocí VBA

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje