Najít a nahradit v Excelu

[ferasusa]

Dobrý den. Prosím o pomoc s excelem. Mám excelový soubor obsahující cca 50 tis. řádků v 6-ti sloupcích. Potřebuji uprgradovat cca 50 různých řádků dle prvního sloupce z jiného souboru v Excelu.Portřebuji najít dle čísel v prvním sloupci řádky a tyto nahradit řádky z jiného souboru. Tohle je na mne příliš složité. Předem děkuji za pomoc.

[Reklama]

[cmuch]

Vítej Na PC-HELP

Ty čísla v prvním sloupci obou souborů budou jedinečná?
Podle shody se přepíšou řádky?

[ferasusa]

Čísla budou jedinečná, jedná se o cenník, to jsem bohužel zapomněl napsat. V podstatě v prvním sloupci je číslo výrobku, v případě shody těchto čísel potřebuji prěpsat ten zbytek. Jedná se o změny cen, či popisu zboží. Děkuji...

[cmuch]

Tady je jedno makro.
Stačí když si změníš názvy souborů a listů, popřípadě sloupce co má prohledávat (zde A v obou sešitech)

Kód: Vybrat vše

Sub Porovnej()

  Dim BlkA As Range, BlkB As Range
  Dim CllA As Range, CllB As Range
  Dim zdrojsesit As Object, cilsesit As Object
  Dim frstAddr As String
  Dim shoda, radek As Integer
 
  On Error GoTo err
  ' definovani bloku bunek na listech (sesit, list, oblast)
  Set zdrojsesit = Workbooks("zdroj.xlsx").Worksheets(1)
  Set cilsesit = Workbooks("cil.xlsm").Worksheets(1)
 
  zdrojsesit.Activate
   Set BlkA = zdrojsesit.Range(("a1:a") & Cells(Rows.Count, "a").End(xlUp).Row)
  cilsesit.Activate
   Set BlkB = cilsesit.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 CllA.Offset(0, 0).Value = "" Then
                 GoTo dalsi  ' skoc na dalsi hodnotu v bloku A
              End If
              If CllB.Offset(0, 0).Value = CllA.Offset(0, 0).Value Then  ' pri shode zkopiruj
                 With zdrojsesit
                   .Rows(CllA.Row).Copy
                 End With
                 With cilsesit
                   .Rows(CllB.Row).PasteSpecial
                 End With
                 Application.CutCopyMode = False
                   
                 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 zdrojsesit = Nothing
  Set cilsesit = Nothing
  Set CllB = Nothing
  Set CllA = Nothing
  Set BlkB = Nothing
  Set BlkA = Nothing
End
err:
MsgBox " !! Neni otevřen jeden ze sešitů !! ", vbCritical
End Sub

[ferasusa]

Jé děkuji, já jen nenapsal, že jsem makro nikdy zatím nepoužil, tak jsem asi v .... , je i na toto nějaká rada?
Jestli můžu připojit vzorek ceníku, nebo poslat názvy sesitů a listů? Omlouvám se, že jsem nenapsal, že jsem v použití maker ještě panic..

[cmuch]

Tak napiš název souboru a listu sešitu, z kterého se to bude aktualizovat a připoj sešit, který se bude aktualizovat.
Makro Ti tam vložím, spouštět se bude třeba tlačítkem.

Jinak o makrech si přečti tady, na pravo pak vše co začíná VBA.

[ferasusa]

Chtěl jsem poprosit o email, jestli je to možné. Jsem lama, ani sem neumím vložit vzorek Excelu

[cmuch]

Přílohy se vkládají takto.