Příspěvky uživatele
< návrat zpět
Navrhoval bych řešení od Vasey, malinko poupravené
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cisla$
Dim radek!
radek = 3
For radek = 3 To UsedRange.Rows.Count
cisla = Range("d" & radek)
If cisla <> Empty Then
Range("e" & radek).FormulaR1C1 = "=" & cisla
Else
Range("e" & radek) = Empty
End If
Next radek
End Sub
Toto makro vložit do příslušného listu, má jedinou nevýhodu - při velkém počtu dat může brzdit výpočet
Lon
Zvolil bych funkci vyhledání souboru
záleží na verzi MSO protože to co funguje v MSO 2003 nefunguje v MSO 2007
Dát do cyklu a skrýt podle prázdné buňky
For i = 1 To 50 ' pro 50 řádků od 1
If Cells(i, 1) = Empty Then ' buňka ve sloupci A je prázdná?
Rows(i).Hidden = True ' ano, skryj řádek
End If
Next i
Lon
For n = 1 To 200
Cells(1, 1) = n
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Next
kde Cells(1,1) je buňka A1
pak bych zkusil zpodmínkovat formou vložení do
Sub UserForm_Activate()
nazev_prvniho_textboxu.Visible = True
nazev_druheho_textboxu.Visible = False
.
.
.
.
nazev_posledniho_textboxu.Visible = False
..........
Tímto se zobrazí pouze první textbox.
Při vyplnění (změně) prvního textboxu, tedy do
Sub nazev_prvniho_textboxu_Change()
zadat podmínku pro vyhodnocení zda je prázdný či nikoliv a
nazev_druheho_textboxu.Visible=True
.......... atd pokračovat až do konce.
Možná po někoho krkolomný popis, ale bez konkrétního zadání a ukázky se "vaří" jen těžko.
Lon
No ale vždyť to funguje jak má???
Co tam je za problém?
Datumy říjen tam nejsou a ani nemohou být zpracovány
ZNOVU OPAKUJI:
hodnoty do sloupce K (tedy 1) zapisuje makro. To je z důvodu nenačítání duplicitních údajů.
Tedy při zadávání dat je nutné ponechat sloupec K nevyplněný!!!
Toto jsem popisoval již několikráte výše
Lon
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í
Lon
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????
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???
Lon
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
Lon
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
Lon
Na čem to jede
verze MSO a verze Win??? + SP u nich?
Přílohu sice nevidím, ale co funkce:
dnešní den =DNES()-A1
včera =DNES()+1-A1
předevčírem =DNES()+2-A1
A1 je buňka s datumem. Formát výsledné buňky pak nastavit na číslo
Nejprve bych ještě zkusil vypnout automatické přepočítávání vzorců a pak optimalizaci smyčky, která provádí "rozkopírování".
Jinak bez zdrojového makra těžko soudit. Ale na ten počet se mi to zase nezdá příliš (samozřejmě pokud je zapnutý automatický přepočet buněk).
NZ
Proto tohle forum existuje
Uživatelské menu
\nFormulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články