VBA Excel - prohledání celého sloupce Vyřešeno

[Branscombe]

Ahoj, potřeboval bych opět pomoc. Mám makro pro kopírování data z jednoho souboru do druhého.

Stanovil jsem si zdroj i cíl

Kód: Vybrat vše

With Worksheets("Zdroj")
Set SBlk = .Range("S2:S" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
Set TCll = Windows("Cil.xlsm").Worksheets("Cil").Range("F3")


A teď mu potřebuji říct, prohledej sloupec "H" v cili a pokud obsahuje hodnotu ze zdroje ze sloupce "Y" tak nic, pokud cil tuto hodnotu ještě neobsahuje kopíruj...

Kód: Vybrat vše

For Each SCll In SBlk.Cells
    tady potřebuji dopsat podmínku, pakliže TCll sloupec "H" neobsahuje hodnotu SCll.Offset(0, 6).Value  " Then
      With TCll
        .Offset(TOfsR, 0).Value = SCll.Offset(0, 0).Value
        TOfsR = TOfsR + 1
      End With
    End If
Next SCll


Díky předem za pomoc...

[Reklama]

[navstevnik]

A co takhle pripojit demo soubor obsahujici zdrojovy a cilovy list? Precizneji specifikovat podminky a co ma byt kopirovano (neni to jednoznacene uveden), nejlepe v priloze prehledne oznac.
Pro tvou informaci k reseni:
pro kazdou bunku ze zdroje (smycka For Each SCll In SBlk.Cells) musis prohledat cil (metoda find) a v pripade splneni podminky kopirovat, takze musis definovat i cilovy blok (nejspis dynamicky podle podminek pro kopirovani, dynamicka pojmenovana oblast?)

[Branscombe]

vzorový soubor v příloze...

Definovat zdroj i cíl a kopírovat data už umím, jde mi jen o stanovení podmínky

Makro by mělo zkopírovat data z řádků ze zdroje do cíle za podmínky že na cílovém listu ve sloupci "C" není ještě pořadové číslo z kopírovaného řádku...

[navstevnik]

Prilozena procedura resi pozadovane (zaremovane radky 'Debug.Print... muzes odstranit):

Kód: Vybrat vše

Option Explicit

Sub Kopiruj()
  Dim SBlk As Range, SCll As Range
  Dim TBlk As Range, TCll As Range, TFRw As Range, TOfsR As Long
  ' definovat bloky
  With ActiveWorkbook.Worksheets("zdroj")
    Set SBlk = .Range("g1:g" & .Cells(.Rows.Count, 7).End(xlUp).Row)
    'Debug.Print SBlk.Address
  End With
  With ActiveWorkbook.Worksheets("cíl")
    Set TBlk = .Range("c1:c" & .Cells(.Rows.Count, 3).End(xlUp).Row)
    Set TFRw = .Range("c1")  ' vychozi radek pro nove zaznamy
    TOfsR = TBlk.Rows.Count  ' ofset pro nove zaznamy
    'Debug.Print TBlk.Address
  End With
  ' prochazet zdrojovy blok
  For Each SCll In SBlk.Cells
    ' prohledat cilovy blok
    With TBlk
      Set TCll = .Find(SCll.Value, LookIn:=xlValue, LookAt:=xlWhole)
      If TCll Is Nothing Then  ' nenalezeno, novy zaznam
        With TFRw
          .Offset(TOfsR, 0).Value = SCll.Value  ' poradove cislo
          .Offset(TOfsR, -1).Value = SCll.Offset(0, -4).Value  ' kod
          .Offset(TOfsR, -2).Value = SCll.Offset(0, -5).Value  'datum
          .Offset(TOfsR, 1).Value = SCll.Offset(0, -1).Value  ' akce
          ' nove definovat cilovy blok a ofset
          With Worksheets("cíl")
            Set TBlk = .Range("c1:c" & .Cells(.Rows.Count, 3).End(xlUp).Row)
            TOfsR = TBlk.Rows.Count
            'Debug.Print TBlk.Address
          End With
        End With
      End If
    End With
  Next SCll
  ' odstranit objektove promenne
  Set SBlk = Nothing
  Set SCll = Nothing
  Set TBlk = Nothing
  Set TCll = Nothing
  Set TFRw = Nothing
End Sub

[Branscombe]

nefunguje mi to

Vyhazuje chybu na řádku "Set TCll = .Find(SCll.Value, LookIn:=xlValue, LookAt:=xlWhole)"

Možná je to amatérské, ale napadlo mě proč si nepřekopírovat data ze zdroje do cíle a poté nepoužít rozšířený filtr s odstraněním duplicitních záznamů ?? To by přeci fungovalo taky a je to jednodušší ne ??

[navstevnik]

Nemel jsem zrovna k dispozici Ex2007, takze to je nekompatibilita s nizsi verzi, ve ktere to je funkcni.
Mohls uvest, jakou chybu hlasil program.
Kdyby sis udelal jen trochu namahy a pokusil se zjistit pricinu chyby, tak bys zjistil, ze v Ex2007 v metode Find parametr LookIn vyzaduje hodnotu xlValues namisto v nizsi verzi xlValue. Uvedeny radek nahrad timto:

Kód: Vybrat vše

Set TCll = .Find(SCll.Value, LookIn:=xlValues, LookAt:=xlWhole)

Tvuj napad s pouzitim rozsireneho filtru je take mozny, ale musis vzhledem k rozdilne strukture polozek v zaznamech zdroj - cil pri kopirovani udelat transformaci sloupcu, zalozit hlavicku Kopirovat do:, vysledek filtrace pak prekopirovat na misto oblasti dat.

[Branscombe]

Díky, nakonec jsem to udělal přes rozšířený filtr.. Ale díky moc za pomoc.