MS Excel

Zdravim, uz par dnu se jako absolutni amater morim s VBA a Excelovskymi funkcemi.
Potrebuji si udelat seznam veci, ktere si chci casove hlidat dle predem daneho intervalu a v ramci prehlednosti potrebuji, aby se zobrazovaly jen udalosti, ktere jsou po nastavenem terminu. Dokazu to presne slovne popsat, ale nejsem schopen to nejak zprovoznit. Vzdycky udelam jen cast a tu nejsem schopen zprovoznit dohromady s druhou.

takze k popisu jak to ma fungovat:
Automaticky pri otevreni listu:
1)Zacni na radku 4 listu 1 s nasledujici funkci: Kdyz bunka F<=aktualni datum, tak radek zviditelni.Jinak ho schovej.

2)Skoc na dalsi radek a opakuj to same s bunkami toho radku na kterem jsi, dokud nedojdes na radek, ktery je prazdny. Pak skonci.

Vysledkem bude jakysi filtr. Bylo by dobre tam dat jeste treba zaskrtavaci tlacitko, ktere by zobrazilo vsechny radky, protoze treba bude chtit nejaky radek poupravit, tak at nemusim cekat na dany datum.

A ted funkce reagujici na zmacknuti tlacitka....jmeno treba "Potvrdit".
1)Po zmacknuti buttonu udelej nasledujici:
Pokud bunka G, prvniho radku v rade(stejne jako predchozi..zacatek na 4 radku), neco obsahuje, zkopiruj cely radek do jineho souboru do listu 1 na volnou pozici(casem se vlastne vytvori jakasi historie).

2)Zmen hodnotu bunky E na aktualni datum, kdy doslo k potvrzeni a vymaz bunku G. Po novem otevreni souboru vlastne dojde k vytrideni zaznamu a zazalohovani stavu.

Na me je to prilis slozite, doufam ze mi nekdo zkuseny ujednodusite zivot:o)
Ja to udelam treba pres makro a filtry ale nevim jak to makro prenest, aby fungovalo pro kazdy radek bez rucnich vstupu(bude jich pres 1000).Zaroven nechci, aby soubor objemove narustal. Staci mit nekdo bokem historii zmen v radcich.

Zaslat odpověď >

Jeza.m(9.7.2009 21:11)#000569

Tady posílám kód který pomůže s fází jedna a tak trochu i s fází dvě - jedná se o smyčku, do kódu jsem dal i popisy jednotlivých řádků:

Dim radek As Single ' deklarace proměnné
radek = 4 ' nastavení prvního prohledávaného řádku na 4
Do While Cells(radek, 6) <> "" 'smyčka dokud v buňce daného řádku, v 6. sloupci (F) je cokoliv jiného než nic
If IsDate(Cells(radek, 6)) = True Then If Cells(radek, 6) <= Date Then Rows(radek).EntireRow.Hidden = True 'obsahuje-li buňka F danného řádku datum, tak je-li toto datum <= aktuální datum, tak skryj
radek = radek + 1 'postup na další řádek
Loop 'jdi na začátek smyčky
End Sub

Při stisku tlačítka lze použít stejná smyčka, která uvnitř bude mít jiný kód.
Pro kopírování do jiného souboru bych asi nepoužil přímo kopírování pro každý řádek, ale během té smyčky bych hodnoty z řádků pro kopírování zapisoval do jiného "pracovního" listu tohoto souboru a teprve po skončení smyčky bych otevřel zálohovací soubor, znovu spustil smyčku pro vyhledání prvního prázdného řádku a tam bych vložil hodnoty z "pracovního" listu, jehož obsah bych poté smazal.citovat

ravalah(10.7.2009 10:06)#000572

Super, diky moc..jdu si s tim zas hrat:)citovat

ravalah(13.7.2009 12:22)#000586

Tak jeden uzivatel na zive.cz to cele udelal. Vypada to, ze to funguje. Tak pro ostatni:
Option Explicit

Private Sub Workbook_Open()
Dim Wsht As Worksheet, CllF As Range, Rws As Range, OfsR As Long
Set Wsht = Worksheets("list1")
With Wsht
Set CllF = .Range("f4")
Set Rws = .Rows(CllF.Row)
End With
OfsR = 0
Application.ScreenUpdating = False
Do While CllF.Offset(OfsR, 0).Value <> vbNullString
With Rws.Offset(OfsR, 0)
If CllF.Offset(OfsR, 0).Value <= Date Then
.Hidden = False
Else
.Hidden = True
End If
End With
OfsR = OfsR + 1
Loop
Application.ScreenUpdating = True
End Subcitovat

ravalah(13.7.2009 12:24)#000587

To horni bylo do ThisWorkbook
A tohle dat do List 1
Option Explicit
Dim MsgResponse

Private Sub CommandButton1_Click()
Dim CllF As Range, RwsF As Range, Rws As Range, OfsR As Long
Dim AWbk As Workbook, AWsht As Worksheet
Dim CestaSoubor As String, Lst As String, LastCll As Range
Dim RwsA As Range, OfsRA As Long
Set CllF = Range("f4")
Set RwsF = Range("a4:g4")
Set Rws = Rows(CllF.Row)
' archiv, list
CestaSoubor = "E:\Excel\Pom\Servis\ServisArchiv.xls"
Lst = "List1"
'otevrit archiv
Application.ScreenUpdating = False
If Not OpenWbkArchiv(AWbk, AWsht, CestaSoubor, Lst) Then _
Application.ScreenUpdating = True: Exit Sub
Set LastCll = AWsht.Cells(Rows.Count, "A").End(xlUp) ' posledni bunka v A:A archivu
Set RwsA = LastCll.Resize(1, 7).Offset(1, 0) ' prvni volny radek v archivu Axx:Gxx
OfsRA = 0 ' ofset pro archiv
OfsR = 0
Do While CllF.Offset(OfsR, 0).Value <> vbNullString
If CllF.Offset(OfsR, 1) <> vbNullString Then ' kdyz Gxx<>"" ulozit do archivu
RwsA.Offset(OfsRA, 0).Value = RwsF.Offset(OfsR, 0).Value
OfsRA = OfsRA + 1
CllF.Offset(OfsR, -1).Value = Date
CllF.Offset(OfsR, 1).Value = vbNullString
Rws.Offset(OfsR, 0).Hidden = True
End If
OfsR = OfsR + 1
Loop
AWbk.Close True ' zavrit archiv a ulozit zmeny
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox1_Click()
Dim CllF As Range, Rws As Range, OfsR As Long
Set CllF = Range("f4")
Set Rws = Rows(CllF.Row)
OfsR = 0
Application.ScreenUpdating = False
Do While CllF.Offset(OfsR, 0).Value <> vbNullString
With Rws.Offset(OfsR, 0)
If CheckBox1.Value = False Then
'skryt
If .Hidden = False And CllF.Offset(OfsR, 0).Value > Date Then _
.Hidden = True
Else
'zobrazit vse
.Hidden = False
End If
End With
OfsR = OfsR + 1
Loop
Application.ScreenUpdating = True
End Sub

Function OpenWbkArchiv(ByRef Wbk As Workbook, ByRef Wsht As Worksheet, CestaSoubor As String, List As String) As Boolean
OpenWbkArchiv = False
On Error GoTo Err1
Set Wbk = Workbooks.Open(CestaSoubor)
On Error GoTo Err2
Set Wsht = Wbk.Worksheets(List)
On Error GoTo 0
OpenWbkArchiv = True: Exit Function
Err1:
MsgResponse = MsgBox("Soubor: " & CestaSoubor & " nelze nalézt," & vbCrLf _
& " zkontrolujte jeho název a umístìní v adresáøi!", vbOKOnly + vbCritical)
Exit Function
Err2:
MsgResponse = MsgBox("List: " & List & " v souboru: " & CestaSoubor & vbCrLf _
& " nelze nalézt, zkontrolujte jeho název!", vbOKOnly + vbCritical)
Wbk.Close
End Functioncitovat

Téma: ExcelVBA mala databaze

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje