< návrat zpět
MS Excel
Téma: uprava kodu 
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
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.
citovatSirka(31.5.2015 13:45)#025280 
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. :)
citovatelninoslov(31.5.2015 16:25)#025281 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 IfcitovatSirka(31.5.2015 18:29)#025283 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. :)
citovatSirka(31.5.2015 18:51)#025284 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) citovatelninoslov(31.5.2015 22:44)#025287 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) citovatSirka(1.6.2015 10:17)#025291 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
citovatSirka(1.6.2015 11:45)#025293 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Á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
Příloha: 25297_kasa3.rar (87kB, staženo 13x) citovatSirka(2.6.2015 12:18)#025317 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
RSS nejnovější články