Opsání Excelového sešitu
Opsání Excelového sešitu
Ahoj, potřeboval bych poradit jak automaticky opsat definované buňky z jednoho sešitu do druhého.
Jedná se o výkazy elektrické energie, kde se do určených buněk vkládají vstupní hodnoty (adresa, stavy elektroměrů, ceny, apod.)
v dalších listech jsou potom údaje zpracovávaný do měsíčních výkazů, faktur a přehledů.
Problém je v tom, že se občas legislativou změní výstupní formuláře a všechny vstupní hodnoty se musí opsat do nového aktualizovaného sešitu dodaného autorem.
Šlo by to naprogramovat, aby se ze sešitu s názvem Energie1.xls zkopírovaly hodnoty z listu "vstupní údaje", vybrané buňky například: A10, D12, H15……. do sešitu Energie2.xls "vstupní údaje" A10, D12, H15,……….
Celkově je těch kopírovaných buněk přes 100 a dělám to pro několik míst. Takže pokud dojde ke změně je to zbytečná práce na půl den.
Moc děkuji za pomoc
Jirka
Jedná se o výkazy elektrické energie, kde se do určených buněk vkládají vstupní hodnoty (adresa, stavy elektroměrů, ceny, apod.)
v dalších listech jsou potom údaje zpracovávaný do měsíčních výkazů, faktur a přehledů.
Problém je v tom, že se občas legislativou změní výstupní formuláře a všechny vstupní hodnoty se musí opsat do nového aktualizovaného sešitu dodaného autorem.
Šlo by to naprogramovat, aby se ze sešitu s názvem Energie1.xls zkopírovaly hodnoty z listu "vstupní údaje", vybrané buňky například: A10, D12, H15……. do sešitu Energie2.xls "vstupní údaje" A10, D12, H15,……….
Celkově je těch kopírovaných buněk přes 100 a dělám to pro několik míst. Takže pokud dojde ke změně je to zbytečná práce na půl den.
Moc děkuji za pomoc
Jirka
Re: Opsání Excelového sešitu
Zdravim,
Kazda bunka se zkopirovat ze souboru Energie1.xls do souboru Energie2.xls takto:
Pokud by to nebyly jen nahodile bunky, ale bunky v nejake posloupnosti (napr. vsechny bunky ve sloupci A nebo kazda druha bunka ve sloupci A, apod). Nebylo by potreba napsat 100x jiny radek kodu (viz vyse), ale pouzit cyklus - to ale zalezi na konkretnich bunkach...
Kazda bunka se zkopirovat ze souboru Energie1.xls do souboru Energie2.xls takto:
Kód: Vybrat vše
Worksheets("Energie2.xls").Range("A10") = Worksheets("Energie1.xls").Range("A10")
Pokud by to nebyly jen nahodile bunky, ale bunky v nejake posloupnosti (napr. vsechny bunky ve sloupci A nebo kazda druha bunka ve sloupci A, apod). Nebylo by potreba napsat 100x jiny radek kodu (viz vyse), ale pouzit cyklus - to ale zalezi na konkretnich bunkach...
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Opsání Excelového sešitu
To poki:
to myslis vazne?
Kdyz uz,tak pro otevrene sesity takto:
No a co se tyce ucelenych bloku bunek (napr.: A1:B10), tak pro kopirovani je vhodne pouzit operace s objekty, napr.:
Worksheets("Energie2.xls").Range("A10") = Worksheets("Energie1.xls").Range("A10")
to myslis vazne?
Kdyz uz,tak pro otevrene sesity takto:
Kód: Vybrat vše
Workbooks("Energie2.xls").Worksheets("vstupní údaje").Range("A10") = Workbooks("Energie1.xls").Worksheets("vstupní údaje").Range("A10")
No a co se tyce ucelenych bloku bunek (napr.: A1:B10), tak pro kopirovani je vhodne pouzit operace s objekty, napr.:
Kód: Vybrat vše
Workbooks("Energiie2.xls").Worksheets("list1").Range("A1:B10").Value = _
Workbooks("Energiie1.xls").Worksheets("list1").Range("A1:B10").Value
Re: Opsání Excelového sešitu
To Navstesvnik: Jajx - tak to byl slusnej ulet .
Kdyby to byl smile, kterej si sype popel na hlavu, tak uz bude videt jen kupa popela.
Omlouvam se timto OmegaNetovi, snad nestihl udelat chybu podle me skvele odpovedi :).
Pokud jde o to kopirovani, tak nevim, jestli je dobry napad kopirovat cele oblasti hodnot, protoze nevis, co je v ostanich bunkach, jestli je zadouci je kopirovat.
Kdyby to byl smile, kterej si sype popel na hlavu, tak uz bude videt jen kupa popela.
Omlouvam se timto OmegaNetovi, snad nestihl udelat chybu podle me skvele odpovedi :).
Pokud jde o to kopirovani, tak nevim, jestli je dobry napad kopirovat cele oblasti hodnot, protoze nevis, co je v ostanich bunkach, jestli je zadouci je kopirovat.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Opsání Excelového sešitu
Pokud je zapotrebi aktualizovat vybrane bunky na stejnych adresach, pak lze pouzit proceduru ve standardnim modulu VBA, treba soubor Energie1:
Kód: Vybrat vše
Option Explicit
Sub Aktualizovat()
Dim SWsht As Worksheet, TWsht As Worksheet
Dim TBlk As Range, TCll As Range
Set SWsht = Workbooks("Energie1.xls").Worksheets("vstupní údaje")
Set TWsht = Workbooks("Energie2.xls").Worksheets("vstupní údaje")
' definovat bunky urcene ke zmene, zapsat vsechny bunky
Set TBlk = TWsht.Range("a1,a3,a5")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
Set TBlk = Nothing
Set TCll = Nothing
Set TWsht = Nothing
Set SWsht = Nothing
End Sub
Re: Opsání Excelového sešitu
Super tohle funguje bezvadně. Děkuji i ostatním. Měl bych ještě jednu doplňující otázku, jak v tomto scriptu definuji změnu na dalších listech? Jde o číslování dokladů, takže na listu "faktura leden" potřebuji zkopírovat D2,D3 "faktura unor" D2,D3..............
Kód: Vybrat vše
Option Explicit
Sub Aktualizovat()
Dim SWsht As Worksheet, TWsht As Worksheet
Dim TBlk As Range, TCll As Range
Set SWsht = Workbooks("Energie1.xls").Worksheets("Vstupní údaje")
Set TWsht = Workbooks("Energie2.xls").Worksheets("Vstupní údaje")
' definovat bunky urcene ke zmene, zapsat vsechny bunky
Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n14")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
Set TBlk = Nothing
Set TCll = Nothing
Set TWsht = Nothing
Set SWsht = Nothing
End Sub
Naposledy upravil(a) omeganet dne 03 bře 2011 23:57, celkem upraveno 1 x.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Opsání Excelového sešitu
jak v tomto scriptu definuji změnu na dalších listech? Jde o číslování dokladů, takže na listu "faktura leden" potřebuji zkopírovat D2,D3 "faktura unor" D2,D3..............
zkus to upresnit, lepsi ale bude, kdyz pripojis ukazku sesitu Energie1, pripadne Energie2 a vyznacis podbarvenim bunek na dalsich listech, co je potreba zkopirovat.
Re: Opsání Excelového sešitu
Tak zatím jsem to zkoušel takhle:
Ale určitě to půjde napsat i optimalizovaněji. Alespoň by se stále nemusel udávat název sešitů, ty by mohly být někde na začátku a pak už jenom odkazem.
Jinak to už funguje na celý sešit.
Ale určitě to půjde napsat i optimalizovaněji. Alespoň by se stále nemusel udávat název sešitů, ty by mohly být někde na začátku a pak už jenom odkazem.
Jinak to už funguje na celý sešit.
Kód: Vybrat vše
Option Explicit
Sub Aktualizovat()
' Vstupní údaje
Dim SWsht As Worksheet, TWsht As Worksheet
Dim TBlk As Range, TCll As Range
Set SWsht = Workbooks("Energie1.xls").Worksheets("Vstupní údaje")
Set TWsht = Workbooks("Energie2.xls").Worksheets("Vstupní údaje")
' definovat bunky urcene ke zmene, zapsat vsechny bunky
Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n9,n14,k22")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
Set TBlk = Nothing
Set TCll = Nothing
Set TWsht = Nothing
Set SWsht = Nothing
' čislovani faktur ZB
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Únor ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Únor ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Březen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Březen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Duben ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Duben ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Květen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Květen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Červen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Červen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Červenec ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Červenec ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Srpen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Srpen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Září ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Září ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Říjen ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Říjen ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Listopad ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Listopad ZB").Range("D2")
Workbooks("Energie2.xls").Worksheets("Faktura Prosinec ZB").Range("D2") = Workbooks("Energie1.xls").Worksheets("Faktura Prosinec ZB").Range("D2")
' fakturační údaje ZB (v dalších verzích upravit pořadí buněk a doplnit nové)
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D4") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("A4")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D7") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D6")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D9") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D8")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D10") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D9")
Workbooks("Energie2.xls").Worksheets("Faktura Leden ZB").Range("D11") = Workbooks("Energie1.xls").Worksheets("Faktura Leden ZB").Range("D10")
' čislovani faktur DE
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Únor DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Únor DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Březen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Březen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Duben DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Duben DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Květen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Květen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Červen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Červen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Červenec DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Červenec DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Srpen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Srpen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Září DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Září DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Říjen DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Říjen DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Listopad DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Listopad DE").Range("D2")
Workbooks("Energie2.xls").Worksheets("Prosinec DE").Range("D2") = Workbooks("Energie1.xls").Worksheets("Prosinec DE").Range("D2")
' fakturační údaje DE (v dalších verzích upravit pořadí buněk a doplnit nové)
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D4") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("A4")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D7") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D6")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D9") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D8")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D10") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D9")
Workbooks("Energie2.xls").Worksheets("Leden DE").Range("D11") = Workbooks("Energie1.xls").Worksheets("Leden DE").Range("D10")
' Výkaz ERU
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A23") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A23")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("F23") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("F23")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A24") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A24")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("F24") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("F24")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A27") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A27")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("F27") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("F27")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A30") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A30")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("I30") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("I30")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("D89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("D89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("G89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("G89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("I89") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("I89")
Workbooks("Energie2.xls").Worksheets("I. čtvrtletí").Range("A94") = Workbooks("Energie1.xls").Worksheets("I. čtvrtletí").Range("A94")
' Výkaz OZE
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("C45") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("C45")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("G47") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("G47")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("F37") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("F37")
' Výkaz OZE
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("C45") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("C45")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("G47") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("G47")
Workbooks("Energie2.xls").Worksheets("Výkaz OZE Leden").Range("F37") = Workbooks("Energie1.xls").Worksheets("Výkaz OZE Leden").Range("F37")
End Sub
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Opsání Excelového sešitu
Trochu polidstena procedura je nize. Urcite by se dalo jeste vice zjednodusit, ale dalsi doplnovani by kvuli neprehlednosti bylo komplikovane.
Protoze nemam testovaci soubory, musis overit funkcnost na kopiich souboru a pripadne chyby vychytat, dopln si dalsi potrebne aktualizace.
Protoze nemam testovaci soubory, musis overit funkcnost na kopiich souboru a pripadne chyby vychytat, dopln si dalsi potrebne aktualizace.
Kód: Vybrat vše
Option Explicit
Sub Aktualizovat()
Dim SWbkN As String, TWbkN As String
Dim SWbk As Workbook, TWbk As Workbook
Dim SWsht As Worksheet, TWsht As Worksheet
Dim TBlk As Range, TCll As Range
Dim i As Integer, SAddrArr As Variant, TAddrArr As Variant
' nazvy otevrenych souboru
SWbkN = "Energie1.xls"
TWbkN = "Energie2.xls"
Set SWbk = Workbooks(SWbkN)
Set TWbk = Workbooks(TWbkN)
' Vstupní údaje
' listy - uprava na jednom listu, vice bunek
Set TWsht = TWbk.Worksheets("Vstupní údaje")
Set SWsht = SWbk.Worksheets(TWsht.Name)
' definovat bunky urcene ke zmene
Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n9,n14,k22")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
' èislovani faktur ZB
' uprava na vice listech, jedna bunka
' vykonat
For Each TWsht In TWbk.Worksheets
If Left(TWsht.Name, 3) = "Fak" And Right(TWsht.Name, 2) = "ZB" Then
TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
End If
Next TWsht
' fakturaèní údaje ZB (v dalších verzích upravit poøadí bunìk a doplnit nové)
' uprava na jednom listu, rozdilne bunky zdroj a cil
Set TWsht = TWbk.Worksheets("Faktura Leden ZB")
Set SWsht = SWbk.Worksheets(TWsht.Name)
TAddrArr = Array("d4", "d7", "d9", "d10", "d11")
SAddrArr = Array("a4", "d6", "d8", "d9", "d10")
For i = LBound(TAddrArr) To UBound(SAddrArr)
TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
Next i
' èislovani faktur DE
' vykonat
For Each TWsht In TWbk.Worksheets
If Right(TWsht.Name, 2) = "DE" Then
TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
End If
Next TWsht
' fakturaèní údaje DE (v dalších verzích upravit poøadí bunìk a doplnit nové)
Set TWsht = TWbk.Worksheets("Leden DE")
Set SWsht = SWbk.Worksheets(TWsht.Name)
TAddrArr = Array("d4", "d7", "d9", "d10", "d11")
SAddrArr = Array("a4", "d6", "d8", "d9", "d10")
For i = LBound(TAddrArr) To UBound(SAddrArr)
TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
Next i
' Výkaz ERU
' listy
Set TWsht = TWbk.Worksheets("I. ètvrtletí")
Set SWsht = SWbk.Worksheets(TWsht.Name)
' definovat bunky urcene ke zmene
Set TBlk = TWsht.Range("a23:a24,f23:f24, a27,f27,a30,i30,a89,d89,g89,i89,a94")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
' Výkaz OZE
' listy
Set TWsht = TWbk.Worksheets("Výkaz OZE Leden")
Set SWsht = SWbk.Worksheets(TWsht.Name)
' definovat bunky urcene ke zmene
Set TBlk = TWsht.Range("c45,g47,f37")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
' odstranit objektove promenne
Set TBlk = Nothing
Set TCll = Nothing
Set TWsht = Nothing
Set SWsht = Nothing
Set TWbk = Nothing
Set SWbk = Nothing
End Sub
Re: Opsání Excelového sešitu
Moc děkuji, je to nádhera, když to takhle někdo umí.
Teď jsem to zkoušel krokovat a hází to malou chybu na posledním řádku při vracení se na další hodnotu Next i
budeš vědět?
Teď jsem to zkoušel krokovat a hází to malou chybu na posledním řádku při vracení se na další hodnotu Next i
budeš vědět?
Kód: Vybrat vše
' uprava na jednom listu, rozdilne bunky zdroj a cil
Set TWsht = TWbk.Worksheets("Faktura Leden ZB")
Set SWsht = SWbk.Worksheets(TWsht.Name)
TAddrArr = Array("d4", "d7", "d9", "d10", "d11")
SAddrArr = Array("a4", "d6", "d8", "d9", "d10")
For i = LBound(TAddrArr) To UBound(SAddrArr)
TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
Next i
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Opsání Excelového sešitu
No a jakou chybu to "hazi"?
Nejspis bude potreba upravit kod v radcich:
ve vsech pripadech pouziti teto casti kodu v procedure, zvyraznuji zmenu:
For i = LBound(TAddrArr) To UBound(TAddrArr)
TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))
Next i
Nejspis bude potreba upravit kod v radcich:
Kód: Vybrat vše
For i = LBound(TAddrArr) To UBound(SAddrArr)
TWsht.Range(TAddrArr).Value = SWsht.Range(SAddrArr)
ve vsech pripadech pouziti teto casti kodu v procedure, zvyraznuji zmenu:
For i = LBound(TAddrArr) To UBound(TAddrArr)
TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))
Next i
Re: Opsání Excelového sešitu
Tak, už to funguje celé. Pomohly ty (i) v závorkách
přikládám finální kód a moc děkuji za pomoc.
Kód: Vybrat vše
TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))
přikládám finální kód a moc děkuji za pomoc.
Kód: Vybrat vše
Option Explicit
Sub Aktualizovat()
Dim SWbkN As String, TWbkN As String
Dim SWbk As Workbook, TWbk As Workbook
Dim SWsht As Worksheet, TWsht As Worksheet
Dim TBlk As Range, TCll As Range
Dim i As Integer, SAddrArr As Variant, TAddrArr As Variant
' nazvy otevrenych souboru
SWbkN = "Energie1.xls"
TWbkN = "Energie2.xls"
Set SWbk = Workbooks(SWbkN)
Set TWbk = Workbooks(TWbkN)
' Vstupní údaje
' listy - uprava na jednom listu, vice bunek
Set TWsht = TWbk.Worksheets("Vstupní údaje")
Set SWsht = SWbk.Worksheets(TWsht.Name)
' definovat bunky urcene ke zmene
Set TBlk = TWsht.Range("a4,d5,a7,d8:d16,b20:n20,b24:n24,b26:n26,b32:n32,n9,n14,k22")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
' čislovani faktur ZB
' uprava na vice listech, jedna bunka
' vykonat
For Each TWsht In TWbk.Worksheets
If Left(TWsht.Name, 3) = "Fak" And Right(TWsht.Name, 2) = "ZB" Then
TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
End If
Next TWsht
' fakturační údaje ZB (v dalších verzích upravit pořadí buněk a doplnit nové)
' uprava na jednom listu, rozdilne bunky zdroj a cil
Set TWsht = TWbk.Worksheets("Faktura Leden ZB")
Set SWsht = SWbk.Worksheets(TWsht.Name)
TAddrArr = Array("a4", "c7", "c9", "c10", "c11")
SAddrArr = Array("a4", "c6", "c8", "c9", "c10")
For i = LBound(TAddrArr) To UBound(SAddrArr)
TWsht.Range(TAddrArr(i)).Value = SWsht.Range(SAddrArr(i))
Next i
' čislovani faktur DE
' vykonat
For Each TWsht In TWbk.Worksheets
If Right(TWsht.Name, 2) = "DE" Then
TWsht.Range("d2").Value = SWbk.Worksheets(TWsht.Name).Range("d2").Value
End If
Next TWsht
' Výkaz ERU
' listy
Set TWsht = TWbk.Worksheets("I. čtvrtletí")
Set SWsht = SWbk.Worksheets(TWsht.Name)
' definovat bunky urcene ke zmene
Set TBlk = TWsht.Range("a23:a24,f23:f24, a27,f27,a30,i30,a89,d89,g89,i89,a94")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
' Výkaz OZE
' listy
Set TWsht = TWbk.Worksheets("Výkaz OZE Leden")
Set SWsht = SWbk.Worksheets(TWsht.Name)
' definovat bunky urcene ke zmene
Set TBlk = TWsht.Range("c45,g47,f37")
' vykonat
For Each TCll In TBlk.Cells
TCll.Value = SWsht.Range(TCll.Address).Value
Next TCll
' odstranit objektove promenne
Set TBlk = Nothing
Set TCll = Nothing
Set TWsht = Nothing
Set SWsht = Nothing
Set TWbk = Nothing
Set SWbk = Nothing
End Sub
Naposledy upravil(a) omeganet dne 04 bře 2011 13:05, celkem upraveno 1 x.
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů