MS Excel

Téma: VBA: Změna barvy u části textu

Zaslal/a Fantasyk 9.12.2021 23:40

Zdravím,
Mám kód (viz níže), který mi přebarví část textu v buňkách. (momentálně to je, když najde Neevidované prostoje- blablabla min)

všechno od Neevidovaného prostoje po min, ale potřeboval byhc tam přidat ještě jednu podmínku, aby to obarvilo jen, když najde vyšší číslovku než 20.

Př.
blablabla Neevidované prostoje- 25min blablabla - tady to zbarví

Př.2
blablabla Neevidované prostoje- 18min blablabla - tady to nezbarví.

Ale jště tam je problém v tom, že tam je někdy "Neevidované prostoje- 1h15min" a to bych taky potřeboval zbarvit

Dim mysRangessse As Range, JE()
Dim substrsse As String, endstrsse As String, neevidovane As String
Dim txtColorsse As Long, xsse As Long, ysse As Long, Possse As Long, endPossse As Long, startPossse As Long, LenEndStrsse As Long

Set mysRangessse = Worksheets(Active).Range("E16:L138")
If mysRangessse.Cells.Count > 1 Then JE = mysRangessse.Value Else ReDim JE(1, 1): JE(1, 1) = mysRangessse.Value
neevidovane = Range("G48").Value

substrsse = neevidovane
endstrsse = "min"
txtColorsse = 7
LenEndStrsse = Len(endstrsse)

For ysse = 1 To UBound(JE, 1)
For xsse = 1 To UBound(JE, 2)
Possse = 1
Do
startPossse = InStr(Possse, JE(ysse, xsse), substrsse, vbTextCompare)
If startPossse <> 0 Then
endPossse = InStr(startPossse, JE(ysse, xsse), endstrsse, vbTextCompare)
If endPossse <> 0 Then
mysRangessse.Cells(ysse, xsse).Characters(Start:=startPossse, Length:=endPossse - startPossse + LenEndStrsse).Font.ColorIndex = txtColorsse
Possse = endPossse + LenEndStrsse

End If
End If

Loop Until startPossse = 0 Or endPossse = 0

Next xsse
Next ysse

díky za jakoukoliv radu

Zaslat odpověď >

eLCHa(15.12.2021 9:13)#051735

Vložte přílohu. Výjimečně jsem si dal práci a vytvořil si soubor a m mně to funguje.citovat

Fantasyk(15.12.2021 13:06)#051744

Příoha

Příloha: zip

51744_test.zip (16kB, staženo 9x)

citovat

elninoslov(15.12.2021 23:22)#051761

pr.

Příloha: zip

51761_vyfarbi-rozmedzie-textu-podla-hodnoty.zip (18kB, staženo 17x)

citovat

Fantasyk(17.12.2021 21:42)#051775

Zdravím,
u této části mi to zežloutne a napíše chybu:
Hodnota = Replace(sHodnota & ":00", "h", ":")

RunTime Error 13

Ale když to mám u tebe v souboru tak to jede, jen to překopíruji do mého a tam to hodí chybu