Příspěvky uživatele
< návrat zpět
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
Sice to není 4, ale 3,......
Pak zřejmě nezbyde než vzorec na výpočet upravit tak, aby z té buňky i s časem vyhodnocoval pouze datum.
Tedy:
buňka A1 obsahuje datum i s časem, buňka B1 je pouze datum; pak
=DATUM(ROK(A1);MĚSÍC(A1);DEN(A1))-B1
rozdíl bude správně vypočten na celé číslo.
Další varianta je použít celé číslo a připočítat (respektive odečítat) 0,99
Co je v buňce zapsáno?
Nejlépe přiložit soubor
Pak bych se podíval na formát buněk. Musí tam být formát datum a typ *14.3.2001 (popř. *14. březen 2001)
Pokud je tam formát 14.3.2010 13:30, pak je to špatně.
Lon
Ve verzi MSO 2007 to funguje 100%
Ano, zamknout sešit.
Použití UserForm by mohlo vyhovovat
Pokud mají být stále zobrazeny sloupce A a B, pak stačí změnit
Range(Cells(1, 1), Cells(ra - 1, ca - 1)).EntireColumn.Hidden = True
za
Range(Cells(1, 3), Cells(ra - 1, ca - 1)).EntireColumn.Hidden = True
Podle názvů rozhodně nepracuji.
V úvodu jsou uvedeny všechny potřebné proměnné s popisem.
Vycházím přesně z Tvého zaslaného návrhu, pokud by byly uvedeny všechny potřebné údaje hned a přesně ...
Stále sice neznám Tvoje "náročné" řešení, ale tohle by mohlo být funkční.
Sub Zobrazeni()
Dim row_offset As Single
Dim col_offset As Single
Dim tab_r_index As Single
Dim tab_c_index As Single
Dim tab_index As Single
Dim row_space As Single
Dim col_space As Single
Dim bunka As String
bunka = "A1" ' buňka určující číslo tabulky pro zobrazení
row_offset = 5 ' počet řádků pro zobrazení
col_offset = 3 ' počet sloupců pro zobrazení
tab_index = 4 ' počet tabulek v řádku
row_space = 3 ' počet prázdných řádků mezi tabulkami
col_space = 2 ' počet prázdných sloupců mezi tabulkami
tab_r_index = 4 ' první řádek první tabulky
tab_c_index = 3 ' první sloupec první tabulky
kolik = Range(bunka)
If kolik > 0 Then
kolik = kolik - 1 ' úprava hodnoty pro výpočty
x = Int((kolik) / tab_index)
ra = tab_r_index + (row_offset + row_space) * x
ca = tab_c_index + (col_offset + col_space) * (kolik - tab_index * x)
rx = ra + row_offset - 1
cx = ca + col_offset - 1
Range(Cells(1, 1), Cells(ra - 1, ca - 1)).EntireColumn.Hidden = True
Range(Cells(rx + 1, cx + 1), Cells(Rows.Count, Columns.Count)).EntireColumn.Hidden = True
Range(Cells(1, 1), Cells(ra - 1, ca - 1)).EntireRow.Hidden = True
Range(Cells(rx + 1, cx + 1), Cells(Rows.Count, Columns.Count)).EntireRow.Hidden = True
End If
End Sub
Zpracováno podle Tebou zaslaného příkladu
Lon
Při změně na listu, nebo při vstupu na list lze vyhodnotit obsah zadané buňky a skrýt to co nepotřebuješ.
Bez příkladu těžko napsat něco konkrétnějšího.
Nevím Tvoji variantu, ale tohle bude asi i rychlejší.
Stačí přidat podmínku, které listy mají zůstat zobrazeny.
Ideální by bylo, kdyby měly nějaké společné pojmenování, pokud to bude ceník 1, ceník 2, ... ceník X, pak stačí přidat vyhodnocení pouze na část názvu.
Samozřejmě odkaz na zviditelnění přidat i do Userformu.
Uživatelské menu
\nMenu
Formulář 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