soucasti meho makra je i cast porovnavajici (na shodnost) cisla, ktera jsou ovsem v ruznych formatech.
Zatimco v jednom sloupci jsou cisla ve formatu 'obecny', druhy sloupec cisel je ve formatu 'vlastni'.
Format 'vlastni' v druhem sloupci je dan tim, ze tyto data byly sbirany rucne a jelikoz byly zadavany cisla ktera maji vzdy stejny prefix, doplnovali se pouze posledni tri řády cisel a 8 mistny prefix se doplnil automaticky.
Pro nazornost prikladam priklad.
Pozadovanym vysledkem je, aby do sloupce C:C bylo po spusteni makra zapsano 'shoda' jak by to fungovalo, kdyby cisla nebyly v rozdilnych formatech.
Kód: Vybrat vše
Option Explicit
Sub Srovnat()
Dim BlkA As Range, BlkB As Range
Dim CllA As Range, CllB As Range
Dim frstAddr As String
' definovani bloku bunek na listech
With Worksheets("List1")
Set BlkA = .Range(("a1:a") & .Cells(.Rows.Count, "a").End(xlUp).Row)
End With
With Worksheets("List2")
Set BlkB = .Range(("a1:a") & .Cells(.Rows.Count, "a").End(xlUp).Row)
End With
' prochazet BlkA
For Each CllA In BlkA.Cells
' prohledavat BlkB
With BlkB
Set CllB = .Find(CllA.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not CllB Is Nothing Then ' pri shode porovnat sloupce B:B
frstAddr = CllB.Address
Do
If CllB.Offset(0, 1).Value = CllA.Offset(0, 1).Value Then ' pri shode doplnit do sl C:C 'shoda'
CllB.Offset(0, 2).Value = "shoda"
End If
Set CllB = .FindNext(CllB)
Loop While CllB.Address <> frstAddr
End If
End With
Next CllA
' odstranit objektove promenne
Set CllB = Nothing
Set CllA = Nothing
Set BlkB = Nothing
Set BlkA = Nothing
End Sub
