coffey33
10.10.16,14:04
Zdravím "poraďáci", chcem Vás poprosiť o pomoc pri bádaní po tom, či excel dokáže zvýrazniť rozdiely v textových reťazcoch pri porovnaní dvoch buniek (viac v prílohe) buď nastavením podmieneného formátovania, vzroca... . Alebo máte nejaký iný návrh ako do docieliť v nejakom z programov balíka MS Office. (bez toho aby som to zvrazňoval slovo za slovom :)) Vďaka za návrhy.
PaloPa
10.10.16,13:49
Tri možné riešenia

1) "Ofarbi iné PÍSMENO v susednom stĺpci"


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


2) "Ofarbi INÉ SLOVO na ROVNAKEJ POZÍCII v susednom stĺpci"


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

3) "Ofarbi SLOVO, ČO NIE JE V ZDROJOVOM stĺpci"


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


P.
coffey33
10.10.16,19:20
Dá sa to ešte upresniť tak aby mi to zvýraznilo i celé slovo napr. ak v TXT_01 dané slovo neexistuje ale v TXT_02 sa nachádza? Dik
PaloPa
12.10.16,18:07
Doplnil som. Zelená verzia robí i BOLD zvýraznených.
coffey33
12.10.16,18:40
No teda, tak to je dobrá pecka!!! Vďaka za snahu, čas. Určite 100% využitie.Ešte raz SUPER a VĎAKA!!!