Srovnání dvou tabulek EXCEL

[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

[Reklama]

[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