Vyhladávanie a nahradenie v xls Vyřešeno

[mlokms]

Zdravím.

Snažím sa dať dokopy (zrejme jednoduché) makro, ktoré by mi dosť uľahčilo život. Bohužial sa s tým ale stretávam po prvý krát a tak som sa pomerne rýchlo zasekol.
Zadanie je nasledovné:
Mám upravený a očesaný cenník, kde je cca 1000 položiek. Pri jeho aktualizácii používam ale kompletný cenník, kde je cca 2500 položiek.
Oba si dám kludne do jedného súboru, každý na iný list. Potrebujem, aby sa mi postupne podľa kódov z jednoduchšieo cenníka vyhľadávali kódy v tom veľkom a následne sa aktuálna cena prekopírovala z toho kompletného cenníka do toho upraveného.
Skúšal som to pomocou nahrávania makra, ale vzniká mi tam jeden problém, ktorý sa mi zatiaľ nepodarilo vyriešiť.

V riadku: Cells.Find mi to hodí tú konkrétnu hodnotu. V tomto prípade zrovna vyhľadávaný kód 0051011299. Ako mám dosiahnuť, aby tam vždy hodilo aktuálne vyhľadávaný kód?
Našiel som tu pár podobných dotazov, ale bohužial sa tam riešili trochu iné problémy, takže mi to moc nepomohlo.
Ďakujem za rady.

Kód: Vybrat vše

Sub Test()
'
' Test Makro
'
'
    Selection.Copy
    Sheets("List 3").Select
    Cells.Find(What:="0051011299", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range("B3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("List 1").Select
    Range("G1").Select
    ActiveSheet.Paste
End Sub

Prikladám aj súbor pre lepšiu predstavu.
https://dl.dropbox.com/u/92126421/Cenik.xlsx

[Reklama]

[cmuch]

Vítej na PC-Help

zkus použít tento kód

Kód: Vybrat vše

Sub Porovnej()

  Dim BlkA As Range, BlkB As Range
  Dim CllA As Range, CllB As Range
  Dim zdroj As Object, cil As Object
  Dim frstAddr As String
  Dim shoda, radek As Integer
 
  ' definovani bloku bunek na listech ( list, oblast)
  Set zdroj = Worksheets("Stare ceny")
  Set cil = Worksheets("Aktualne ceny")
 
  zdroj.Select
 
   Set BlkA = zdroj.Range(("a5:a") & Cells(Rows.Count, "a").End(xlUp).Row)
   Set BlkB = cil.Range(("a1:a") & Cells(Rows.Count, "a").End(xlUp).Row)
 
 
  shoda = 0 ' pocet shod
 
  Application.ScreenUpdating = False

      ' 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
            frstAddr = CllB.Address
            Do
              If CllB.Offset(0, 0).Value = CllA.Offset(0, 0).Value Then  ' pri shode zkopiruj
                 
                 CllA.Offset(0, 10).Value = CllB.Offset(0, 1).Value
                   
                 shoda = shoda + 1
                 GoTo dalsi ' skoc na dalsi hodnotu v bloku A
              End If
              Set CllB = .FindNext(CllB)

            Loop While CllB.Address <> frstAddr
          End If
dalsi:
        End With
      Next CllA
     
  Application.ScreenUpdating = True

  MsgBox "   Uff, nasel jsem " & shoda & " shod.", vbInformation

  ' odstranit objektove promenne
  Set zdroj = Nothing
  Set cil = Nothing
  Set CllB = Nothing
  Set CllA = Nothing
  Set BlkB = Nothing
  Set BlkA = Nothing
End Sub


[mlokms]

Vďaka za privítanie a za rýchlu odpoveď a pomoc.
Funguje to, ale zapisuje to obrátene. Prikladám presne ten súbor, čo potrebujem upravovať. Potrebujem, aby makro vzalo vždy kód z listu "Stare ceny", vyhladalo ten kód v liste "Aktualne ceny", zkopíravolao príslušnú cenu z listu "Aktuálne ceny" a vložilo ju do správneho riadku na liste "Staré ceny" (sloupec K).

https://dl.dropbox.com/u/92126421/Cenik2.xlsx

Snažil som sa ešte upraviť ten tvoj kód, ale ako som písal, bojujem s tým prvý krát a moc mi to teda nejde. Začalo to vyhadzovať chyby a skončil som.

Budeš prosím tak dobrý a pozrieš na to ešte raz?

Ďakujem.

[cmuch]

Upravený kód jsem vložil do předchozího příspěvku.

[mlokms]

Naozaj moc vďaka.
Hodne si mi pomohol a ušetril kopu práce

Ďakujem!