jarojr
16.08.14,08:41
Vie mi niekto poradiť, ako sa dá nastaviť v exceli automatické skopírovanie z bunky v ktorej beží live údaj do novej bunky tak, aby v novej bunke zostal skopírovaný údaj staticky tak, ako bol skopírovaný v určitom čase. "napríklad: v bunke a1 beží čas a ja ho chcem skopírovať automaticky o cca 15:00 do bunky b1 (15:00). Do bunky b1 sa údaj nakopíruje o 15:00, teda b1 = 15:00. V bunke a1 sa údaj po minúte mení na 15:01, ale v bunke b1 zostane starý údaj 15:00. Ďakujem...
bodliak
16.08.14,08:19
Naprogramovať vo VBA.
jarojr
16.08.14,14:19
To mi je jasné,ale je forma aj priamo v exceli, tak asi takú informáciu by som potreboval..
PaloPa
16.08.14,16:27
1| Treba spustiť OnTime funkciu - treba 1x spustiť pri štarte zošita (fn Workbook_Open() - VBA kód nad ThisWorkBook)
Private Sub Workbook_Open()
Call TikTak
End Sub
2| V OnTime funkcii zabezpečiť posúvanie času, kedy sa spustí vykonávanie update príslušnej bunky dTime = Now + TimeSerial(0, 0, 10) (v príklade je každých 10 sekúnd):
Public Sub TikTak()
Dim a As Range, b As Range
On Error Resume Next
Set a = ThisWorkbook.Sheets("Sheet1").Range("A1")
Set b = ThisWorkbook.Sheets("Sheet1").Range("B6000").End(xlUp) 'posl riadok
If b.Text <> "" Then Set b = b.Offset(1, 0)
b.Value = a.Value
DalsiTik = Now + TimeSerial(0, 0, 10) 'kazdych 10 sekund
Application.OnTime DalsiTik, "TikTak"
End Sub
Točenie v rozsahu B1:B10 možno napr takouto funkciou:
Sub Rotuj_b1az10(xLstTime As Variant)
Dim rng As Range, f As Range, c As Range, mx As Variant
On Error GoTo xErr
Set rng = Sheet1.Range("B1:B10")
Set c = rng.Cells(1) 'B1
mx = (Application.WorksheetFunction.Max(rng))
If mx <> 0 Then
Set f = rng.Find(What:=CDate(mx), LookIn:=xlFormulas, LookAt:=xlWhole)
If Not f Is Nothing Then
If f.Row < 10 Then Set c = f.Offset(1, 0)
End If
End If
c.Value = xLstTime
Exit Sub
xErr:
MsgBox Err.Description
End Sub
Jej volanie z fn TikTak: Call Rotuj_b1az10(a.Value)
Ad kópia viacerých buniek - viď riešenie "export dát z webového reportu do excelu (http://pc-prog.eu/phpBB3/viewtopic.php?f=5&t=702)"
P.
Private Sub Workbook_Open()
Call TikTak
End Sub
2| V OnTime funkcii zabezpečiť posúvanie času, kedy sa spustí vykonávanie update príslušnej bunky dTime = Now + TimeSerial(0, 0, 10) (v príklade je každých 10 sekúnd):
Public Sub TikTak()
Dim a As Range, b As Range
On Error Resume Next
Set a = ThisWorkbook.Sheets("Sheet1").Range("A1")
Set b = ThisWorkbook.Sheets("Sheet1").Range("B6000").End(xlUp) 'posl riadok
If b.Text <> "" Then Set b = b.Offset(1, 0)
b.Value = a.Value
DalsiTik = Now + TimeSerial(0, 0, 10) 'kazdych 10 sekund
Application.OnTime DalsiTik, "TikTak"
End Sub
Točenie v rozsahu B1:B10 možno napr takouto funkciou:
Sub Rotuj_b1az10(xLstTime As Variant)
Dim rng As Range, f As Range, c As Range, mx As Variant
On Error GoTo xErr
Set rng = Sheet1.Range("B1:B10")
Set c = rng.Cells(1) 'B1
mx = (Application.WorksheetFunction.Max(rng))
If mx <> 0 Then
Set f = rng.Find(What:=CDate(mx), LookIn:=xlFormulas, LookAt:=xlWhole)
If Not f Is Nothing Then
If f.Row < 10 Then Set c = f.Offset(1, 0)
End If
End If
c.Value = xLstTime
Exit Sub
xErr:
MsgBox Err.Description
End Sub
Jej volanie z fn TikTak: Call Rotuj_b1az10(a.Value)
Ad kópia viacerých buniek - viď riešenie "export dát z webového reportu do excelu (http://pc-prog.eu/phpBB3/viewtopic.php?f=5&t=702)"
P.
jarojr
17.08.14,02:59
Ďakujem veľmi pekne. Ani neviete ako mi to pomohlo.. Super prajem príjemnú nedeľu, ešte raz ďakujem...
jarojr
17.08.14,03:57
Chcel by som Vás ešte poprosiť, ak je to možné, ako zadám aby sa to točilo v nejakom cykle, teda od bunky b1 po b10 a potom by prepísalo postupne bunku b1 - b10 novými údajmi a tak dokola? Ďakujem
jarojr
17.08.14,08:44
Sub TikTak()
Dim a As Range, b As Range
On Error Resume Next
Set a = ThisWorkbook.Sheets("Hárok1").Range("A1")
Set b = ThisWorkbook.Sheets("Hárok1").Range("b1").End(xlUp) 'posl riadok
If b.Text <> "" Then Set b = b.Offset(0, 0)
b.Value = a.Value
'a.Value = Now()
DalsiTik = Now + TimeSerial(0, 0, 2) 'kazdych 2 sekund
Application.OnTime DalsiTik, "TikTak"
End Sub
/ Keby som chcel kopírovať viacej buniek na raz, vedeli by ste mi napísať nejaký príklad?/ V VB niesom doma a dosť sami to zapáčilo, iba že sa mi na to akosi nedarí prísť/ Ďakujem...
Dim a As Range, b As Range
On Error Resume Next
Set a = ThisWorkbook.Sheets("Hárok1").Range("A1")
Set b = ThisWorkbook.Sheets("Hárok1").Range("b1").End(xlUp) 'posl riadok
If b.Text <> "" Then Set b = b.Offset(0, 0)
b.Value = a.Value
'a.Value = Now()
DalsiTik = Now + TimeSerial(0, 0, 2) 'kazdych 2 sekund
Application.OnTime DalsiTik, "TikTak"
End Sub
/ Keby som chcel kopírovať viacej buniek na raz, vedeli by ste mi napísať nejaký príklad?/ V VB niesom doma a dosť sami to zapáčilo, iba že sa mi na to akosi nedarí prísť/ Ďakujem...