Stránka 1 z 1
VBA Excel - prohledání celého sloupce
Napsal: 10 zář 2010 09:59
od 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...
Re: VBA Excel - prohledání celého sloupce
Napsal: 10 zář 2010 10:31
od 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?)
Re: VBA Excel - prohledání celého sloupce
Napsal: 10 zář 2010 10:47
od 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...
Re: VBA Excel - prohledání celého sloupce
Napsal: 10 zář 2010 11:35
od 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
Re: VBA Excel - prohledání celého sloupce
Napsal: 10 zář 2010 12:54
od 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 ??
Re: VBA Excel - prohledání celého sloupce
Napsal: 10 zář 2010 16:18
od 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.
Re: VBA Excel - prohledání celého sloupce
Napsal: 13 zář 2010 10:19
od Branscombe
Díky, nakonec jsem to udělal přes rozšířený filtr.. Ale díky moc za pomoc.