Vyhledání hodnoty v oblasti a zápis do vedlejší buňky

[m.niki]

Dobrý den, potřeboval bych poradit s makrem, které by v oblasti S3:S168 vyhledalo hodotu buňky A1, a potom o dvě buňky vedle a dvě buňky dolů od buňky obsahující hodnotu buňky A1, zapsalo hodnotu buňky B1. Takže v případě, že by hodnota buňky A1 byla v buňce S68, zapsala by se hodnota buňky B1 do buňky U70. Hodnota buňky A1 může být v žádné, jedné, nebo i více buňkách z výše uvedené oblasti. Děkuji moc za rady

[mike007]

A musí to být nutně makro? Na to stačí jednoduchý vzoreček s fcí KDYŽ (IF) + absolutní adresování.

[navstevnik]

Nas zakaznik, nas pan.
Poslouzi tato procedura:

Kód: Vybrat vše

Option Explicit

Sub NajdiDosad()
  Dim Blk As Range, BCll As Range
  Dim ACll As Range
  Dim FrstAddr As String
  With Worksheets("list1")
    Set ACll = .Range("a1")  ' zdroj
    Set Blk = .Range("s3:s168") ' definice prohledavaneho bloku
    ' prohledat blok
    With Blk
      Set BCll = .Find(ACll.Value, LookIn:=xlValues, LookAt:=xlWhole)
      If Not BCll Is Nothing Then  ' nalezena shoda
        FrstAddr = BCll.Address
        Do
          BCll.Offset(2, 2).Value = ACll.Offset(0, 1).Value  ' vlozit hodnotu z B1
          Set BCll = .FindNext(BCll)  ' hledat dal
        Loop While Not BCll Is Nothing And BCll.Address <> FrstAddr
      End If
    End With
  End With
  ' odstranit objektove promenne
  Set ACll = Nothing
  Set Blk = Nothing
  Set BCll = Nothing
End Sub

[m.niki]

Oběma vám děkuji za rychlou reakci, makro to být musí, je to součástí většího projektu. Návštěvníku tvoje makro jsem ozkoušel a jako vždy funguje perfektně, díky moc.