< 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
Sirka(17.12.2015 18:30)#028745 
ahoj,
tak přeci jen jsem našel "chybku"
prosím o navedení jak provést kontrolu na "číslo" která tam je, ale aby nešlo zadat např 95+. hodnota -95 ale musí fungovat (to teď funguje).
pokud by tomu plus nešlo zabránit jednodušeji, tak mě napadlo zadání pouze ze seznamu, tam bych zadal všechny celá čísla od 9999 do -9999.
děkuji :)
citovatelninoslov(21.12.2015 9:57)#028772 
Zmente v procedúre listu "zaznam"
Private Sub Worksheet_Change(ByVal Target As Range)
riadok
If Not IsNumeric(Bunka.Value) Then
na
If Not IsNumeric(Bunka.Value) Or Right(Bunka.Value, 1) = "+" Or Right(Bunka.Value, 1) = "-" ThencitovatSirka(21.12.2015 14:34)#028773 super funguje, díky moc :)
citovat
RSS nejnovější články