Srovnání dvou tabulek EXCEL
Napsal: 13 led 2015 09:28
od Blackdog1591
Zdravím Vám, potřeboval bych nutně poradit se srovnáváním dvou tabulek. Mám dvě tabulky vedle sebe. Potřebuji vyfiltroval shodné produkty podle čísla produktu a srovnat je vedle sebe. Jedná se o srovnání produktů ze dvou let. Ty produkty, které se koupily v roce 2011, ale nekoupily se v roce 2012 (a naopak), by se měly vymazat, nebo posunou pod toto srovnání(prostě aby se nepletly do této tabulky). Prosím o pomoc. Potřebuji to tento týden. Díky Honza
Re: Srovnání dvou tabulek EXCEL
Napsal: 14 led 2015 13:22
od cmuch
Ahoj,
bude stačit takto?
Kód: Vybrat vše
Sub Porovnej()
Dim BlkA As Range, BlkB As Range
Dim CllA As Range, CllB As Range
Dim shoda As Integer
' definovani bloku bunek na listech
Set BlkA = ActiveSheet.Range(("a2:a") & Cells(Rows.Count, "a").End(xlUp).Row)
Set BlkB = ActiveSheet.Range(("f2:f") & Cells(Rows.Count, "f").End(xlUp).Row)
Application.ScreenUpdating = False
shoda = 0 ' pocet shod
opak1:
' prochazet BlkA
For Each CllA In BlkA.Cells
' prohledavat BlkB
With BlkB
Set CllB = .Find(CllA.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If CllB Is Nothing Then ' pri shode porovnat sloupce f:f
Range(CllA.Address).Resize(1, 3).Delete Shift:=xlUp
GoTo opak1
End If
End With
Next CllA
opak2:
' prochazet BlkB
For Each CllB In BlkB.Cells
' prohledavat BlkA
With BlkA
Set CllA = .Find(CllB.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If CllA Is Nothing Then ' pri shode porovnat sloupce f:f
Range(CllB.Address).Resize(1, 3).Delete Shift:=xlUp
GoTo opak2
End If
End With
Next CllB
Application.ScreenUpdating = True
MsgBox " Uff, hotovo.", vbInformation
' odstranit objektove promenne
Set CllB = Nothing
Set CllA = Nothing
Set BlkB = Nothing
Set BlkA = Nothing
End Sub