Sub Farbi_Ine_v_bunke() ' crea by PaloPa Dim StartChar As Integer, _ InaFarbaDlzka As Integer, _ xStart As Integer, _ xEnd As Integer Dim c As Range, xSource As Range Set xSource = Selection For Each c In xSource xStart = 0: xEnd = 0: InaFarbaDlzka = 0 For i = 1 To Len(c.Text) If xStart = 0 And Mid(c.Text, i, 1) <> Mid(c.Offset(0, 1).Text, i, 1) Then xStart = i End If If xStart <> 0 And Mid(c.Text, i, 1) <> Mid(c.Offset(0, 1).Text, i, 1) Then xEnd = i End If Next i If xStart <> 0 Then xEnd = IIf(xEnd = 0, xStart, xEnd) InaFarbaDlzka = xEnd + 1 - xStart End If If InaFarbaDlzka <> 0 Then c.Offset(0, 1).Characters(Start:=xStart, Length:=InaFarbaDlzka).Font.Color = RGB(255, 0, 0) End If Next c End Sub
Sub Farbi_IneSlovo_v_bunke() Dim InaFarbaDlzka As Integer, xStart As Integer Dim aSrc, aTrg, c As Range, xSource As Range, tf As Boolean Set xSource = Selection For Each c In xSource aSrc = Split(c.Text, " "): aTrg = Split(c.Offset(0, 1).Text, " ") xStart = 0: InaFarbaDlzka = 0 If UBound(aSrc) > UBound(aTrg) Then GoTo xNextC For i = LBound(aTrg) To UBound(aTrg) tf = False If i > UBound(aSrc) Then xStart = Len(c.Text) + 1 InaFarbaDlzka = Len(c.Offset(0, 1).Text) - xStart + 1 tf = True ElseIf (aSrc(i) <> aTrg(i)) Then xStart = InStr(1, c.Offset(0, 1).Text, aTrg(i)) InaFarbaDlzka = Len(aTrg(i)) tf = True End If If tf Then c.Offset(0, 1).Characters(Start:=xStart, Length:=InaFarbaDlzka).Font.Color = RGB(255, 0, 0) End If Next i xNextC: Next c End Sub
Sub Farbi_NonExstSlovo_v_bunke() Dim InaFarbaDlzka As Integer, xStart As Integer Dim aTrg, c As Range, xSource As Range On Error GoTo xErr Set xSource = Selection For Each c In xSource aTrg = Split(c.Offset(0, 1).Text, " ") xStart = 0: InaFarbaDlzka = 0 ' sú presne rovanké If c.Offset(0, 1).Text = c.Text Then GoTo xNextC For i = LBound(aTrg) To UBound(aTrg) ' slovo nie je v zdroji If InStr(1, c.Text, aTrg(i)) = 0 Then xStart = InStr(1, c.Offset(0, 1).Text, aTrg(i)) InaFarbaDlzka = Len(aTrg(i)) c.Offset(0, 1).Characters(Start:=xStart, Length:=InaFarbaDlzka).Font.Color = _ RGB(0, 100, 0) c.Offset(0, 1).Characters(Start:=xStart, Length:=InaFarbaDlzka).Font.Bold = _ True End If Next i xNextC: Next c Exit Sub xErr: MsgBox Err.Description, vbCritical, "CHYBA" End Sub
Užitočné (3) | Kabaka123, coffey33, ivka70 |
EXCEL - zvýraznený rozdiel pri porovnaní dvoch textových reťazcov