< návrat zpět

MS Excel


Téma: Makro podle data rss

Zaslal/a 28.9.2010 8:27

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

Příloha: rar2546_test-radekb.rar (27kB, staženo 22x)
Zaslat odpověď >

Strana:  1 2   další »
#002548
Začátečník
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
#002549
avatar
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
#002550
Začátečník
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
#002552
avatar
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
#002553
Začátečník
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
#002554
avatar
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
#002555
Začátečník
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
#002556
avatar
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
#002557
Začátečník
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
#002558
avatar
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: rar2558_test-radekb.rar (31kB, staženo 24x)
citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09