Potřebuji pomoci se vzorečkem Vyřešeno

[Branscombe]

Ahoj všem,

potřeboval bych pomoci s jedním vzorečkem. Ve sešitu v příloze mám ve sloupci "B" datum a potřebuji do sloupce "A" dopsat vzoreček pro vypsání pořadového čísla ve formě jak je uvdeno ve vzorovém příkladu.

Barevné rozlišení slouží pouze pro snazší orientaci v datech.

Pomůžete mi někdo ?? Předem díky za všechny tipy jak daný problém vyřešit ...

[Reklama]

[vonv]

Jak jsou ty čísla jednotlivým datumům přidělovány?
Pouze na základě předchozího data a pak nové číslování od 0001 při změně roku? jak se čísluje přechod na další měsíc?

[Branscombe]

Je to vždy "rok" ze sloupce "B" a pořadové číslo pro onen rok od 1 do nekonečna

Měsíce neřeším, ale při přechodu na další rok začíná vše od jedničky ... Datumy jsou napřeskáčku ...

[navstevnik]

V editoru VBA (Alt+F11) vloz do:
- modulu listu 0km udalostni proceduru:

Kód: Vybrat vše

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Row = 1 Or Target.Column <> 2 Or Not IsDate(Target.Value) Then Exit Sub
  Application.EnableEvents = False
  Target.Offset(0, -1).Value = PoradoveCislo(Target.Value)
  Application.EnableEvents = True
End Sub

- standardniho modulu funkci:

Kód: Vybrat vše

Option Explicit

Function PoradoveCislo(Datum As Date) As String
If Datum < #1/1/2010# Then PoradoveCislo = vbNullString: Exit Function
  Dim Blk As Range, Cll As Range
  Dim frstAddr As String
  Dim PoslPorCis As String
  With Worksheets("0km")
    Set Blk = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
  End With
  PoslPorCis = vbNullString
  With Blk ' najit nejvyssi por cislo odpovidajici roku
    Set Cll = .Find(Year(Datum) & "-", LookIn:=xlValues, LookAt:=xlPart)
    If Not Cll Is Nothing Then
      frstAddr = Cll.Address
      Do
        If Cll.Value > PoslPorCis Then PoslPorCis = Cll.Value
        Set Cll = .FindNext(Cll)
      Loop While Not Cll Is Nothing And Cll.Address <> frstAddr
    End If
  End With
  If PoslPorCis <> vbNullString Then
  PoradoveCislo = Year(Datum) & "-" & Right("000" & Val(Right(PoslPorCis, 4)) + 1, 4)
  Else
  PoradoveCislo = Year(Datum) & "-0001"
  End If
End Function

' pro otestovani funkce
Private Sub test()
Debug.Print PoradoveCislo(#10/3/2012#)
End Sub


Vlozenim data do sloupce B:B bude do sloupce A:A vlozeno poradove cislo, vystup upraven pro maximalni poradove cislo yyyy-9999, odvozeno z ukazky.

[Branscombe]

Zkoušel jsem to, ale nefunguje ... Správně je pouze vždy první pořadové číslo a další vyhodnotí jako chybu ...

[navstevnik]

???

[Branscombe]

Asi bude chyba u mě, ale asi to moc nechápu... Jak tam vložím to pořadové číslo ??
Myslel jsem že vytvořená funkce ve VBA se vloží jako vzorec do excelu. Ale když zadám do buňky A2 "=poradovecislo(B2)" tak mi to nefunguje ...

[navstevnik]

V odpovedi vyse jsem uvedl, ze mas vlozit udalostni proceduru do listu 0km a do standardniho modulu funkcni proceduru (funkci).
a dale jsem uvedl:

Vlozenim data do sloupce B:B bude do sloupce A:A vlozeno poradove cislo, vystup upraven pro maximalni poradove cislo yyyy-9999, odvozeno z ukazky.

Takze jeste jednou:
Po vlozeni uvedenych procedur v editoru VBA pak uz jen vkladas do bunek sloupce B2:Bxx datum a do sloupce A2:Axx je vygenerovano poradove cislo pozadovaneho tvaru.

Vzorcem (uzivatelskou funkci) ve sloupci A2:Axx nelze pozadavek vyresit, nebot je nutno ve funkci vzhledem k neusporadani poradovych cisel prohledavat cely sloupec (nalezt nejvyssi poradove cislo odpovidajici roku), coz v ramci uzivatelske funkce pri rekurentnim volani skonci chybou 91 - Object variable not set. Navic zde pristupuje problem cyklickeho odkazu, takze i jiny zpusob vyhledani bez rekurentniho volani funkce neprinese ocekavany vysledek.

[Branscombe]

Jo takhle... No jo, jsem blbej ... Díky moc ...

Jen ještě jeden dotázek, když jsem toto vložil do souboru, tak mi to při ukládání vyhazuje hlášku "Upozornění týkající se osobních údajů: Tento dokument obsahuje makra, ovládací prvky ActiveX, informace rozšiřujícího balíku XML nebo webové komponenty. Ty mohou obsahovat osobní údaje, které nelze Kontrolou metadat odebrat." Kde je chyba ?? Díky moc

[navstevnik]

Prilisna pece MS o bezpecnost osobnich udaju:

...Ty mohou obsahovat osobní údaje, které...

[Branscombe]

To jo, ale co s tím aby se mi to nezobrazovalo ??

[navstevnik]

Takto chovajici se soubor jsi prilozil, nejspi otevrit novy oubor a do nej prekopirovat procedury a zalozit novy list 0km, pokud neodstranis priciny.