MS Excel

Ahoj,potřebuji poradit s tímto problémem.
Mám sešit (vzor v příloze) kde mám pojmenované listy dle měsíců v roce. Dále list kde jsou vypsány trvalé platby podle kal.dnů. A potřebuji :
1. spustit makro při otevření sešitu
2. makro má za úkol zkontrolovat trvalé platby a pokud se shoduje kalendářní den a aktuálním datem, pak zapsat trvalou platbu tj. řádek A(číslo dle datumu)až řádek J(číslo dle datumu) do prvního volného řádku v daném listě dle akt. měsíce.
Asi moc komplikované, ale děkuji za případné návrhy.
radekb

Zaslat odpověď >

Strana: 1 2 další »

Začátečník(28.9.2010 16:49)#002548

Na rychlo mě napadá snad jen přímočaré:

Private Sub Workbook_Open()
x = 1
While Cells(x, 2) <> Empty
datum = Cells(x, 2) + Str(Cells(x, 1)) + "," + Str(Cells(x, 3))

If Date = CDate(datum) Then
'nalezena shoda
mesic = Cells(x, 2)
sl_A = Cells(x, 1)
sl_B = Cells(x, 2)
sl_C = Cells(x, 3)
sl_D = Cells(x, 4)
sl_E = Cells(x, 5)
sl_F = Cells(x, 6)
sl_G = Cells(x, 7)
sl_H = Cells(x, 8)
sl_I = Cells(x, 9)
sl_J = Cells(x, 10)

y = 3
While Sheets(mesic).Cells(y, 1) <> Empty
y = y + 1
Wend

Sheets(mesic).Cells(y, 1) = sl_A
Sheets(mesic).Cells(y, 2) = sl_B
Sheets(mesic).Cells(y, 3) = sl_C
Sheets(mesic).Cells(y, 4) = sl_D
Sheets(mesic).Cells(y, 5) = sl_E
Sheets(mesic).Cells(y, 6) = sl_F
Sheets(mesic).Cells(y, 7) = sl_G
Sheets(mesic).Cells(y, 8) = sl_H
Sheets(mesic).Cells(y, 9) = sl_I
Sheets(mesic).Cells(y, 10) = sl_J
End If
x = x + 1
Wend
End Sub

Samozřejmě uloženo v ThisWorkboks.
Popis snad ani není nutný, ale učesat se to dá určitě.

Nedostatky:
neřešil jsem vícenásobné otevření sešitu (opakované zapisování položek), ....
Navrhuji např. do sloupce K na listu "trvalé platby" zadávat hodnotu 1 při zápisu položky a tyto pak již dále nezpracovávat.
Změněné pak tedy:

Private Sub Workbook_Open()
Sheets("trvalé platby").Select
x = 1
While Cells(x, 2) <> Empty
datum = Cells(x, 2) + Str(Cells(x, 1)) + "," + Str(Cells(x, 3))

If Date = CDate(datum) Then
'nalezena shoda
mesic = Cells(x, 2)
If Cells(x, 11) <> 1 Then ' nebo <1
sl_A = Cells(x, 1)
sl_B = Cells(x, 2)
sl_C = Cells(x, 3)
sl_D = Cells(x, 4)
sl_E = Cells(x, 5)
sl_F = Cells(x, 6)
sl_G = Cells(x, 7)
sl_H = Cells(x, 8)
sl_I = Cells(x, 9)
sl_J = Cells(x, 10)

y = 3
While Sheets(mesic).Cells(y, 1) <> Empty
y = y + 1
Wend

Sheets(mesic).Cells(y, 1) = sl_A
Sheets(mesic).Cells(y, 2) = sl_B
Sheets(mesic).Cells(y, 3) = sl_C
Sheets(mesic).Cells(y, 4) = sl_D
Sheets(mesic).Cells(y, 5) = sl_E
Sheets(mesic).Cells(y, 6) = sl_F
Sheets(mesic).Cells(y, 7) = sl_G
Sheets(mesic).Cells(y, 8) = sl_H
Sheets(mesic).Cells(y, 9) = sl_I
Sheets(mesic).Cells(y, 10) = sl_J

Cells(x, 11) = 1
End If
End If
x = x + 1
Wend
End Sub

Loncitovat

radekb(28.9.2010 17:31)#002549

Ahoj, smekám. Zatím funguje. Ale bude fungovat i v měsící říjen atd.? když je funkce následně vyrušena?
Abych se přiznal ve VBA jsem opravdu začátečník a jsem vděčný za každou radu.citovat

Začátečník(28.9.2010 17:34)#002550

Musí to fungovat v jakémkoliv měsíci.
Od toho je podmínka:
If Date = CDate(datum) Then
ta vyhodnocuje zadaný den.

Můžete zkusit cvično změnu systémového datumu Vašeho PC a uvidíte.
POZOR na nesprávně zapsané datumy jako jsou 31.září 2010, adt.... NENÍ OŠETŘENO

Loncitovat

radekb(28.9.2010 18:10)#002552

Tak vyzkoušeno při změně systémového data a funguje pouze když vymažu ty jedničky ve sloupci K. Dá se s tím něco udělat??citovat

Začátečník(28.9.2010 18:15)#002553

Tak to bylo popsáno v zadání.
pokud je ve sloupci K zapsána 1, pak je údaj zpracován v daném měsíci na jeho kartě.
Pokud tam je jiná hodnota, pak se považuje za "nezkopírovaný" - kvůli duplicitám při opakovaném otevření sešitu v zadaný den.
Neví co je myšleno pojmem - Dá se s tím něco udělat???

Loncitovat

radekb(28.9.2010 18:23)#002554

Jenže pokud je tam to číslo, nezkopíruje se již do listu říjen nic.
Nechal jsem zapsat trvalé platby pro den 28.září. Poté jsem změnil sys.datum na 28.říjen a do listu "říjen" se po otevření sešitu nic nevypsalo. Až když jsem vymazal ty jedničky u data 28.říjen se zápis provedl.citovat

Začátečník(28.9.2010 18:34)#002555

To je velice zvláštní, teď jsem povedl pouze zkopírování pár položek a zadal datum říjen a změnil jsem systémový čas.
Vše funguje naprosto v pohodě.

Kontroluje se pouze odpovídající den, tak jak bylo popsáno v zadání.

Nevím co více by se Vám mělo dále kopírovat????citovat

radekb(28.9.2010 18:49)#002556

Tak nevím. Mě to nefunguje. Mohl by si mi zaslat ten sešit, kde ti to funguje.
No a taky mě teď napadlo, že když neotevřu sešit zrovna v ten den kdy je nějaká trvalá platba tak se mi zpětně nic nezapíše. Tohle jde nějak ošetřit? Jo jinak děkuji moc za trpělivost!!citovat

Začátečník(28.9.2010 18:56)#002557

Aha, domnívám se, že jsi určitě vyplnil i sloupec K při zadání údajů. Ten slouží pouze pro to makro aby nedocházelo k duplicitám, tak jak jsem psal výše (proč ten sloupec využívá makro).
Samozřejmě pokud v daný den nebude sešit otevřen, pak se nic nezapíše.
stačí zaměnit
If Date = CDate(datum) Then
za:
If Date >= CDate(datum) Then
pak při otevření se zapíší všechny starší nezapsané hodnoty.

Vycházel jsem z původního zadání

Loncitovat

radekb(28.9.2010 19:24)#002558

Tak stále mi to nefunguje. Ošetření staršího data je o.k., ale pro měsíc říjen pokud jsou ve sloupci již jedničky - nefunguje :o( Žádné data ve sloupci K jinak nemám. Ještě jednou posílám soubor s již vepsaným makrem. Jinak budu muset končit...pokračování zítra odpoledne. Ještě jednou tisíceré díky.

Příloha: rar

2558_test-radekb.rar (31kB, staženo 24x)

citovat

Strana: 1 2 další »

Téma: Makro podle data

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje