Zdravim vsechny odborniky excelu.
Pripravuji cenik v excelu, ktery ma cca 300 listu, v priloze je vzorek me prace.
Ted v cem je problem.....
Na kazdem listu jsou ceny produktu (cervene vyznacene-pocatecni ceny), jakmile ale budu chtit udelat na cely cenik slevovou akci napr.20% tak bych musel kazdou bunku s cenou zvlast prepocitavat, coz asi bude casove dost narocne.
Tak prosim jestli si nekdo nevi rady jak nejjednodussim zpusobem upravit ceny v ceniku kdyz napr.na prvnim vytvorenem listu budu mit stav cen (100%) a budu chtit udelat slevu na 80%, tak napriklad pri prepsani ze 100 na 80 by se upravila cena u vsech produktu na vsech listech?
Je to vubec proveditelne ? Diky kazdemu kdo by mi mohl v tomto pomoci ?
(mam ted O2K3, ale neni problem dokoupit i novou verzi Office)
Roman
EXCEL: Makro pro upravu cen v ceniku Vyřešeno
EXCEL: Makro pro upravu cen v ceniku
- Přílohy
-
- cenik.xls
- (82 KiB) Staženo 46 x
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: EXCEL: Makro pro upravu cen v ceniku
Predpoklad je, ze struktura vsech listu je identicka - ceny jsou v bloku bunek C:J. Dalsi predpoklad je, ze pouze v radcich oznacenych Cena bez DPH jsou ciselne hodnoty, jinak by v jinych radcich doslo k "uprave hodnot" .
Potom lze pouzit nasledujici proceduru (v editoru VBA - Alt+F11 - vloz do standardniho modulu, uprav koeficient na pozadovanou hodnotu a zavolej z nabidky Nastroje>Makro>...). Ale veskere overovani delej na kopii ceniku a navic to je na tve vlastni riziko, nenesu jakoukoliv odpovednost za pripadne skody. Vysledek upravy prover.
A zvladne to i Excel 2000-2003
Potom lze pouzit nasledujici proceduru (v editoru VBA - Alt+F11 - vloz do standardniho modulu, uprav koeficient na pozadovanou hodnotu a zavolej z nabidky Nastroje>Makro>...). Ale veskere overovani delej na kopii ceniku a navic to je na tve vlastni riziko, nenesu jakoukoliv odpovednost za pripadne skody. Vysledek upravy prover.
Kód: Vybrat vše
Option Explicit
Sub HromadnaUpravaCen()
Dim Wsht As Worksheet, Blk As Range, PClls As Range, Cll As Range
Dim Koeficient As Single
' zde vloz koeficient upravy (desetinny oddelovac je ve VBA: . (tecka)
Koeficient = 1
'***************************
For Each Wsht In ActiveWorkbook.Worksheets
Set Blk = Nothing
Set Blk = Intersect(Wsht.UsedRange, Wsht.Range("c:j")) ' oblast cen
Set PClls = Nothing
Set PClls = Blk.SpecialCells(xlCellTypeConstants, xlNumbers) ' bunky s cenami
For Each Cll In PClls.Cells
Cll.Value = Cll.Value * Koeficient ' nasobit koeficientem
Next Cll
Next Wsht
' odstranit objektove promenne
Set Cll = Nothing
Set PClls = Nothing
Set Blk = Nothing
Set Wsht = Nothing
End Sub
A zvladne to i Excel 2000-2003
Re: EXCEL: Makro pro upravu cen v ceniku
No to neni mozne ) Ten pan navstevnik je proste " EXCELentni " .
Funguje to uzasne, jeste to otestuji v kopii kompletniho sesitu ceniku a provedu kontrolu udaju, ale uz ted to vypada moc dobre a tech par radku, ktere pan navstevnik napsal mi urcite usetri spoustu casu a ja mu timto skladam velkou poklonu.
Diky, diky, diky
Roman
Funguje to uzasne, jeste to otestuji v kopii kompletniho sesitu ceniku a provedu kontrolu udaju, ale uz ted to vypada moc dobre a tech par radku, ktere pan navstevnik napsal mi urcite usetri spoustu casu a ja mu timto skladam velkou poklonu.
Diky, diky, diky
Roman
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: EXCEL: Makro pro upravu cen v ceniku
Nize je procedura doplnena o osetreni stavu, kdy na listu nebude nalezena bunka obsahujici v zadane oblasti ciselnou hodnotu (Cenu):
Kód: Vybrat vše
Option Explicit
Sub HromadnaUpravaCen()
Dim Wsht As Worksheet, Blk As Range, PClls As Range, Cll As Range
Dim Koeficient As Single
' zde vloz koeficient upravy (desetinny oddelovac je ve VBA: . (tecka)
Koeficient = 1
'***************************
For Each Wsht In ActiveWorkbook.Worksheets
Set Blk = Nothing
Set Blk = Intersect(Wsht.UsedRange, Wsht.Range("c:j")) ' oblast cen
Set PClls = Nothing
On Error Resume Next
Set PClls = Blk.SpecialCells(xlCellTypeConstants, xlNumbers) ' bunky s cenami
On Error GoTo 0
If Not PClls Is Nothing Then
For Each Cll In PClls.Cells
Cll.Value = Cll.Value * Koeficient ' nasobit koeficientem
Next Cll
End If
Next Wsht
' odstranit objektove promenne
Set Cll = Nothing
Set PClls = Nothing
Set Blk = Nothing
Set Wsht = Nothing
End Sub
Re: EXCEL: Makro pro upravu cen v ceniku
Na to jsem ani nepomyslel, to je dobre osetreni, protoze mam na nekterych listech pouze doplnkove informace a tam to hlasilo chybu.
Vidim, ze jsem se dostal k tomu spravnemu odbornikovi :)
Mohl bych tedy jeste poprosit o jednu vychytavku, pokud je proveditelna? Sly by ty vysledne hodnoty zaokrouhlovat na cele desetniky? Vim, ze by se to dalo osetrit zmenou poctu desetinnych mist na jedno (to excel dopocita), ale to uz potom nevypada jako cena, ale obycejne cislo. Tedy kdyz makro spocita napr hodnotu 58,63 tak aby se automaticky zaokrouhloval na 58,60 nebo v pripade 62,77 na hodnotu 62,80 ?
Diky za Vas cas pane navstevniku.
Vidim, ze jsem se dostal k tomu spravnemu odbornikovi :)
Mohl bych tedy jeste poprosit o jednu vychytavku, pokud je proveditelna? Sly by ty vysledne hodnoty zaokrouhlovat na cele desetniky? Vim, ze by se to dalo osetrit zmenou poctu desetinnych mist na jedno (to excel dopocita), ale to uz potom nevypada jako cena, ale obycejne cislo. Tedy kdyz makro spocita napr hodnotu 58,63 tak aby se automaticky zaokrouhloval na 58,60 nebo v pripade 62,77 na hodnotu 62,80 ?
Diky za Vas cas pane navstevniku.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: EXCEL: Makro pro upravu cen v ceniku Vyřešeno
Doplneno o zaokrouhlovani (bankovni) a format 0,00:
Ma to ovsem jeden dusledek, nelze presne prepocitat na puvodni ceny (* 0,80 a zpet * 1,25).
Kód: Vybrat vše
Option Explicit
Sub HromadnaUpravaCen()
Dim Wsht As Worksheet, Blk As Range, PClls As Range, Cll As Range
Dim Koeficient As Single
' zde vloz koeficient upravy (desetinny oddelovac je ve VBA: . (tecka)
Koeficient = 1
'***************************
For Each Wsht In ActiveWorkbook.Worksheets
Set Blk = Nothing
Set Blk = Intersect(Wsht.UsedRange, Wsht.Range("c:j")) ' oblast cen
Set PClls = Nothing
On Error Resume Next
Set PClls = Blk.SpecialCells(xlCellTypeConstants, xlNumbers) ' bunky s cenami
On Error GoTo 0
If Not PClls Is Nothing Then
For Each Cll In PClls.Cells
' nasobit koeficientem, zaokrouhlit na 1 des misto (bankovni zaokuhl.), format 0,00
Cll.Value = CSng(Format(Round(Cll.Value * Koeficient, 1), "0.00"))
Next Cll
End If
Next Wsht
' odstranit objektove promenne
Set Cll = Nothing
Set PClls = Nothing
Set Blk = Nothing
Set Wsht = Nothing
End Sub
Ma to ovsem jeden dusledek, nelze presne prepocitat na puvodni ceny (* 0,80 a zpet * 1,25).
Re: EXCEL: Makro pro upravu cen v ceniku
To uz mi nevadi, protoze budu pocitat pouze s cenou aktualni (navic si muzu delat zalohu predchozich cen a tim osetrim tuto odchylku ve vypoctech). Tohle chodi presne podle mych predstav, parada.
Tak dekuji za pomoc.
Roman
Tak dekuji za pomoc.
Roman
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 3
- 435
-
od Lukk_as93
Zobrazit poslední příspěvek
24 dub 2024 15:37
-
-
Sestava cca 50 000,- prosím o názor, či úpravu
od Hejhul » 18 dub 2024 11:47 » v Rady s výběrem hw a sestavením PC - 2
- 791
-
od Alferi
Zobrazit poslední příspěvek
18 dub 2024 12:58
-
-
- 9
- 1182
-
od mmmartin
Zobrazit poslední příspěvek
29 srp 2023 16:47
-
- 16
- 6490
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 2
- 1902
-
od honzzicek
Zobrazit poslední příspěvek
01 črc 2023 08:57
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 36 hostů