< návrat zpět
MS Excel
Téma: uprava kodu ![rss](./plugins/templates/wall_2C/images/icons/rss.png)
Zaslal/a Sirka 30.5.2015 20:12
zdravim, potřeboval bych pomoct s upravou kodu
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, ZamkRng As Range, Prepinac As String
Set Zmena = Intersect(Range("B5:B26,F5:F26"), Target) 'Zisti prienik zmien s kontrolovanou oblasťou
If Not Zmena Is Nothing Then 'Pokračuj iba ak bol prienik
For Each Bunka In Zmena 'Pre všetky zmenené bunky v kontrolovanej oblasti
Prepinac = IIf(Bunka.Column = 2, "A", "H") 'Nastav prepínač zapisovaných stĺpcov v liste A
With Worksheets("kontrola")
With .Cells(.Cells(Rows.Count, Prepinac).End(xlUp).Row + 1, Prepinac) 'Nastav na prvý voľný riadok v správnom zapisovacom stĺpci
If Not IsEmpty(Bunka) Then .Value = Bunka.Offset(0, 1).Value 'Ak zmenu nevyvolalo vymazávanie, tak zapíš hodnotu z bunky vpravo od zmenenej
End With
End With
Next Bunka
Set ZamkRng = Nothing
For Each Bunka In Range("B5:B26,F5:F26") 'Prejdi celú kontrolovanú oblasť
If Not IsEmpty(Bunka) Then 'Ak bunka nieje prázdna pridaj ju do oblasti na zamknutie
If ZamkRng Is Nothing Then Set ZamkRng = Bunka.Offset(0, -1).Resize(1, 2) Else Set ZamkRng = Union(ZamkRng, Bunka.Offset(0, -1).Resize(1, 2))
End If
Next Bunka
If Not ZamkRng Is Nothing Then 'Sú nejaké bunky v oblasti na zamknutie ?
With ZamkRng
Unprotect Password:="heslo" 'Najskôr odomkni list
.Locked = True 'Zamkni všetky bunky v oblasti na zamknutie
.FormulaHidden = False
Protect Password:="heslo", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Zamkni list
End With
End If
Set ZamkRng = Nothing
End If
End Sub
potřeboval bych aby to s kopírovanou hodnotou zapisovalo i aktualni datum v době zápisu (zapsat do sloupce B, a pokud by to kopírovalo ze sloupce druheho tak do H). Ale nevím jak toho docílit :(
prosím pomoc
tzn.
hodnoty A
![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
Nie som uz pri Pc a na zajtra mam uz asi plan, ale tak narychlo z tabletu:
Urobte si napr dalsi prepinac2, a riadok so zapisom Today do bunky. obdobne ako sme to roboli doteraz. Z tablet a v polospanku vam nedokazem pomoct. Jedina zajtra ked budem ready, a inak ste to mohli supnut tam kde sme riesili tento problem 1x.
citovat
Sirka(31.5.2015 13:45)#025280 ![avatar](./pictures/avatars/no-avatar.jpg)
tak jsem přidaval přepínač a mořád jsem byl v bugu :( asi jsem to daval na špatne misto... tak pokud by jste měl čas tak bych se nezlobil. :)
citovat
elninoslov(31.5.2015 16:25)#025281 ![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
Iba toto
If Not IsEmpty(Bunka) Then .Value = Bunka.Offset(0, 1).Value 'Ak zmenu nevyvolalo vymazávanie, tak zapíš hodnotu z bunky vpravo od zmenenej
zmeňte na toto:
If Not IsEmpty(Bunka) Then
.Value = Bunka.Offset(0, 1).Value 'Ak zmenu nevyvolalo vymazávanie, tak zapíš hodnotu z bunky vpravo od zmenenej
.Offset(0, 1).Value = Date 'a pripíš aktuálny dátum
End Ifcitovat
Sirka(31.5.2015 18:29)#025283 ![avatar](./pictures/avatars/no-avatar.jpg)
a kdybych chtěl přidat i čas do stejne buňky s datumem?
If Not IsEmpty(Bunka) Then .Value = Bunka.Offset(0, 1).Value 'Ak zmenu nevyvolalo vymazávanie, tak zapíš hodnotu z bunky vpravo od zmenenej
.Offset(0, 1).Value = Date 'a pripíš aktuálny dátum
.Offset(0, 2).Value = Time 'a připiš čas
takhle to mám ve třech sloupečcích
i tak děkuji. :)
citovat
Sirka(31.5.2015 18:51)#025284 ![avatar](./pictures/avatars/no-avatar.jpg)
akorát se naskytl problem, při zápisu hodnoty zkratkou ctrl+q se zapíše prázdný řádek s datem. :((( zasílám i soubor pro náhlednutí.
Příloha:
25284_kasa.rar (82kB, staženo 13x) citovat
elninoslov(31.5.2015 22:44)#025287 ![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
1. Chýba Vám tam "End If" - nezkopírovali ste to poriadne.
2. Odstránil som Vám tam zbytočné neustále adresovanie Sheetov, selektovanie, odomykanie... Otestujte to.
3. Nerozumiem ale tomu, prečo sa má zapisovať aj firma, v ktorej nič nevyplníte do evidencie ? To ste mal asi na mysli tým, že sa Vám zapisuje iba dátum (to je inak zmenené dátum + čas). To by sa malo ošetriť podmienkou ešte.
Příloha:
25287_kasa2.rar (89kB, staženo 13x) citovat
Sirka(1.6.2015 10:17)#025291 ![avatar](./pictures/avatars/no-avatar.jpg)
vypadá že po upravách funguje:) děkuji.
akorát mam problém pokud zadam do ZAZNAM něco jiného než číslo (kontroluji přes ověření dat) tak mi to tu hodnotu po zadání správné zanese 3x
citovat
Sirka(1.6.2015 11:45)#025293 ![avatar](./pictures/avatars/no-avatar.jpg)
jinak k bodu 3
zapisuje to hodnotu 0 správně, protože do budoucna to bude na jednom vytištěném učtu taktéž (doufám že tato budoucnost je hodně vzdálená).
tedy pokud jsem pochopil otázku správně.
citovat
![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
Áno, problém robí práve to overenie dát. Zrušil som ho, a nahradil bezproblémovou podmienkou.
Prosím vyskúšajte funkčnosť, a či sa zapisujú tie firmy (aj vyplnené aj nevyplnené) tak ako majú, alebo to treba upraviť. Práve sa mi už nechce rozmýšľať nad tým, čo som napísal ja, a čo Vy
![7](./plugins/templates/wall_2C/images/smileys/7.gif)
Příloha:
25297_kasa3.rar (87kB, staženo 13x) citovat
Sirka(2.6.2015 12:18)#025317 ![avatar](./pictures/avatars/no-avatar.jpg)
jsem si to myslel :)... děkuji zatím vypadá že funguje.
musím to otestovat hlouběji. Kdyby něco, tak se ozvu, ale zatím vypadá OK.
díky moc.
citovat