Excel porovnat dva sloupce

[Zhouba]

Mám v listu sloupec A s cca 15000 řádky, sloupec B s cca 500 řádky. Potřeboval bych načíst hodnotu B2 a projet sloupec A, zda se tam hodnota nenachází. V případě, že ano, označit buňku barevně. Na konci sloupce A na prázdné buňce se vrátit se zpět do sloupce B, načíst další buňku a takto opakovat cyklus až do konce sloupce B. Už se s VBA mořím hodinu, ale na nic jsem nepřišel. Děkuji za pomoc.

[mmmartin]

označit buňku barevně.

Kterou, tu ve sloupci A, nebo tu ve sloupci B?

[Zhouba]

Buňku ve sloupci A. Předem děkuji

[cmuch]

Ahoj,
Vyzkoušej toto:

Kód: Vybrat vše

Sub VyhledatDoplnit()
  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("list1")
    Set BlkB = .Range(("b1:b") & .Cells(.Rows.Count, "b").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 obarvy
        frstAddr = CllB.Address
        Do
          If CllB.Offset(0, 0).Value = CllA.Offset(0, 0).Value Then  ' pri shode doplnit barvu
             CllA.Offset(0, 0).Interior.ColorIndex = 3 ' Oznaci barevne policka v bloku A
            'CllB.Offset(0, 0).Interior.ColorIndex = 3 ' Oznaci barevne policka v bloku B
          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

[Zhouba]

Velice děkuji, pracuje to jak má. Na tohle bych těžko sám přišel ve svém věku (velice pozdním). :)