To je fakt divná tabuľka aj požiadavka. Nedáva mi to zmysel. Ale budiš...
Příloha: 
32667_evidencia-vydavkov.zip (15kB, staženo 29x)
citovat32667_evidencia-vydavkov.zip (15kB, staženo 29x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Excel - vloženie dátumu pri zadaní hodnoty do pj
MS Excel
Téma: Excel - vloženie dátumu pri zadaní hodnoty do pj 
Zaslal/a 6.9.2016 9:04
Mám vytvorene vydavky v exceli. Chcel by som taku funkciu že ak zadam nejaku hodnotu do prazdneho riadku napr. vydaj napr.: hypoteka sumu 220, tak s avypni aut. akt. datum v bunke A17, taktiež ked zadam nejake cislo do buniek od C4-C100 až U4-A100.
dekuji
Například nějak takto:
=KDYŽ(COUNTBLANK(C4:U4)=19;"";DNES())Jenom upozorňuji, že funkce DNES vrací aktuální datum, takže se bude každý den měnit... Pokud má být datum zadané napevno, tak je třeba jej překopírovat na hodnotu. Případně si lze také napsat ve VBA událost listu, která bude toto datum vkládat na základě nějaké podmínky, například:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 4 To 100
If Cells(i, 1).Value = "" And _
Application.WorksheetFunction.CountBlank(Range(Cells(i, 3), Cells(i, 21))) <> 19 Then
Cells(i, 1).Value = Date
End If
Next i
End SubP.citovat
=KDYŽ(COUNTBLANK(C4:U4)=19;"";DNES())Jenom upozorňuji, že funkce DNES vrací aktuální datum, takže se bude každý den měnit... Pokud má být datum zadané napevno, tak je třeba jej překopírovat na hodnotu. Případně si lze také napsat ve VBA událost listu, která bude toto datum vkládat na základě nějaké podmínky, například:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 4 To 100
If Cells(i, 1).Value = "" And _
Application.WorksheetFunction.CountBlank(Range(Cells(i, 3), Cells(i, 21))) <> 19 Then
Cells(i, 1).Value = Date
End If
Next i
End SubP.citovat
Aháá, do prázdneho riadku, a ja reku že do prázdnej bunky... Preto mi to nešlo do hlavy, som myslel, že sa hocikedy môže meniť hociktorá bunka, a má sa zistiť či sa zapisuje nová hodnota, ale v prípade že tam už bola, tak nič. Preto som cez Undo zisťoval predošlý stav. No nič, no ... 
citovat
citovat
32816_chyba2.jpg
Vymente tú časť riadku za
Cells(Rows.Count, 1).End(xlUp).Offset(1) = Date
Predošlý robí problém ak tam nieje žiaden záznam. ALE, to len na okraj, je to zbytočné, lebo Vy takýto nezmysel nepotrebujete. Ja som Vás zle pochopil, a rovno som aj napísal, že mi nedáva zmysel zadanie, a preto je nezmysel aj riešenie.
Skôr to potrebujete nahradiť tým, čo Vám poslal Pavlus. Tu je trošičku upravená verzia:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long, C As Integer
R = Target.Row: C = Target.Column
If R > 3 And C > 2 And C < 22 Then
Application.EnableEvents = False
If WorksheetFunction.CountBlank(Cells(R, 3).Resize(, 19)) <> 19 Then
If Cells(R, 1) = "" Then Cells(R, 1) = Date
Else
Cells(R, 1).ClearContents
End If
Application.EnableEvents = True
End If
End Sub
citovat
Cells(Rows.Count, 1).End(xlUp).Offset(1) = Date
Predošlý robí problém ak tam nieje žiaden záznam. ALE, to len na okraj, je to zbytočné, lebo Vy takýto nezmysel nepotrebujete. Ja som Vás zle pochopil, a rovno som aj napísal, že mi nedáva zmysel zadanie, a preto je nezmysel aj riešenie.
Skôr to potrebujete nahradiť tým, čo Vám poslal Pavlus. Tu je trošičku upravená verzia:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long, C As Integer
R = Target.Row: C = Target.Column
If R > 3 And C > 2 And C < 22 Then
Application.EnableEvents = False
If WorksheetFunction.CountBlank(Cells(R, 3).Resize(, 19)) <> 19 Then
If Cells(R, 1) = "" Then Cells(R, 1) = Date
Else
Cells(R, 1).ClearContents
End If
Application.EnableEvents = True
End If
End Sub
citovat
[/quote]
Dakujem. Už je to v pohode.
citovat
elninoslov napsal/a:
Vymente tú časť riadku za
Cells(Rows.Count, 1).End(xlUp).Offset(1) = Date
Predošlý robí problém ak tam nieje žiaden záznam. ALE, to len na okraj, je to zbytočné, lebo Vy takýto nezmysel nepotrebujete. Ja som Vás zle pochopil, a rovno som aj napísal, že mi nedáva zmysel zadanie, a preto je nezmysel aj riešenie.
Skôr to potrebujete nahradiť tým, čo Vám poslal Pavlus. Tu je trošičku upravená verzia:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long, C As Integer
R = Target.Row: C = Target.Column
If R > 3 And C > 2 And C < 22 Then
Application.EnableEvents = False
If WorksheetFunction.CountBlank(Cells(R, 3).Resize(, 19)) <> 19 Then
If Cells(R, 1) = "" Then Cells(R, 1) = Date
Else
Cells(R, 1).ClearContents
End If
Application.EnableEvents = True
End If
End Sub
Dakujem. Už je to v pohode.
citovatUživatelské menu
Nejste přihlášen(a)
\n
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Aktivní diskuse
Čas od do
lubo • 19.4. 16:30
Makro smyčka
MilanKop • 19.4. 10:46
Makro smyčka
elninoslov • 19.4. 9:02
Čas od do
elninoslov • 19.4. 8:46
Čas od do
jarek1111 • 18.4. 13:46
Čas od do
lubo • 18.4. 11:13
Čas od do
jarek1111 • 18.4. 8:32
RSS nejnovější články