jak zkrátit podmínky za If Vyřešeno

[atari]

Mám deklarované tyto tři datumy jako svátky (bude jich ale asi 150):

Kód: Vybrat vše

Sv1 = #1/1/2010#
Sv2 = #5/1/2010#
Sv3 = #5/8/2010#


a ted potřebuji proměnnou datum porovnat zda není svátek:

Kód: Vybrat vše

datum = Cells(1, 5)
If datum = Sv1 Or datum = Sv2 Or datum = Sv3 Then
    Cells(1, 1) = "ano"
    Else
    Cells(1, 1) = "ne"
End If


Tři datumy není problém popsat pomocí operátoru "Or", ale až jich budou desítky, tak psát 150x "Or datum = Sv1" se mi nechce. Chtěl bych ten zápis nějak zjednodušit asi v tomto smyslu:
Pokud se proměnná "datum" rovná nějakému datumu z tého množiny stopadesáti datumů Sv1 až Sv150. Ale nepřišel jsem na to, jak to udělat. Napadlo mě dát ty datumy do pole Sv(1) až Sv(150), ale nevím jak dál. Lze toto nějak řešit?

[Reklama]

[navstevnik]

Vytvor si kolekci svatku a overuj, zde kolekce obsahuje pozadovane datum.
viz priloha

[atari]

Děkuji - dobrý námět, o kolekcích jsem ještě neslyšel. Jsem takový samouk. Tak jsem ještě procházel net a zjistil jsem, co to ty kolekce jsou. Zápis jsem pochopil. Ale mám dvě otázky:

Kód: Vybrat vše

 KolDat.Add "ano", CStr(Sv(i))

V tomto řádku, který přidává hodnoty do kolekce, je "ano". K čemu to tam je?

A pak mám druhý dotaz, neumím porovnat "Datum" zda obsahuje hodnotu z kolekce. Jediné co mě napadlo, je v cyklu For - Next, porovnat hodnoty Sv(i) s proměnnou "Datum". Jenže to už pak nepotřebuji kolekci , ale stačí mě pracovat s polem.

Takže pokud to je složité, to tady vysvětlovat amatérovi, (mě) tak to udělám tím polem přes FOR - NEXT a bude to vyřešené.

[navstevnik]

Pouziti kolekce jsem minil jako jedno z moznych reseni, samozrejme lze pouzit i pouhe prohledavani pole Array - Test1 nebo vyuzit prikaz Select Case - Test2 (navic i umozni pripadne vetveni programu na zaklade vyrazu):

Kód: Vybrat vše

Sub Test1()
  Dim Sv As Variant, i As Integer, OK As Boolean
  Sv = Array(#1/1/2010#, #5/1/2010#, #5/8/2010#) ' seznam dat
  OK = False
  For i = 0 To 2
  If Sv(i) = #1/1/2010# Then OK = True: Exit For
  Next i
End Sub
Sub Test2()
  Dim OK As Boolean
  OK = False
  Select Case Date '#1/1/2010#
    Case #1/1/2010#, #5/1/2010#, #5/8/2010#
      OK = True
  End Select
End Sub

Pro maly pocet prvku to je asi vyhodnejsi, pro onech uvazovanych 150 prvku uz bude pouziti kolekce rychlejsi.
Objekt Collection je tvoreny polozkami a klici k temto polozkam. V danem pripade, kdy je overovano datum, je klic datum a potrebna polozka muze byt cokoliv, takze jsem zvolil "ano". V modulu2 je vyznam polozky a klice jasnejsi.
PS.: Pokud je tech 150 svatku mineno za obdobi vice roku, existuje efektivnejsi reseni pro pevne a pohyblive svatky v roce, nez psat tech 150 svatku (vlozit do standardniho modulu):

Kód: Vybrat vše

Option Explicit

Dim Sv() As Date

Sub Test3()
' vyhleda v poli svatek
  Dim Dt As Date, i As Byte, OK As Boolean
  Dt = #4/5/2010# 'Date
  SetSv Year(Dt)
  OK = False
  For i = 0 To UBound(Sv)
    If Sv(i) = Dt Then OK = True: Exit For
  Next i
End Sub
Private Sub SetSv(rok As Integer)
  Dim i As Byte, ArrSvatky As Variant
    ' pevne svatky + 2x velikonoce
  ArrSvatky = Array("1.1.", "1.5.", "8.5.", "5.7.", "6.7.", "28.9.", "28.10.", _
      "17.11.", "24.12.", "25.12.", "26.12.")
  ReDim Sv(UBound(ArrSvatky) + 2)
  For i = 0 To UBound(ArrSvatky)
    Sv(i) = CDate(ArrSvatky(i) & rok)
  Next i
  ' doplneni velikonoc
  Sv(i) = oud(rok)   ' vel nedele
  Sv(i + 1) = Sv(i) + 1   ' vel pondeli
End Sub

Private Function oud(rok As Integer)
' Oudinova metoda vypoctu data Velikonocni nedele
  Dim storoc As Integer, G As Integer, k As Integer, i As Integer
  Dim A As Integer, B As Integer, c As Integer, D As Integer
  Dim j As Integer, l As Integer, mes As Byte, Den As Byte
  storoc = rok \ 100
  G = rok Mod 19
  k = (storoc - 17) \ 25
  i = (storoc - storoc \ 4 - (storoc - k) \ 3 + 19 * G + 15) Mod 30
  A = i \ 28
  B = 29 \ (i + 1)
  c = (21 - G) \ 11
  i = i - A * (1 - A * B * c)
  D = rok \ 4
  j = (rok + D + i + 2 - storoc + storoc \ 4) Mod 7
  l = i - j
  mes = 3 + (l + 40) \ 44
  Den = l + 28 - 31 * (mes \ 4)
  oud = DateSerial(rok, mes, Den)
End Function


[atari]

No to je SUPER !!!!!! to poslední Makro . Děkuji moc.
Vydedukoval jsem z toho že ta dávka Sub Test3() se spouští a porovnává datum v hodnotě Dt. Ten Private Sub SetSv(rok As Integer) se automaticky spustí při spuštění Sub Test3() a naplní proměnnou Sv(). A ta Sub Function.. je mi jasná. Uvažuji správně?

[navstevnik]

Ano, je to tak (ta posledni procedura je funkce - Function, takze ne Sub Function).
no a zde je pro pripad potreby uzivatelska funkce (vlozit do standardniho modulu, ve kterem jsou procedury patrici k Sub Test3):

Kód: Vybrat vše

Function JeSvatek(dt As Date) As Boolean
' vyhleda v poli svatek
  Dim i As Byte
  SetSv Year(dt)
  JeSvatek = False
  For i = 0 To UBound(Sv)
    If Sv(i) = dt Then JeSvatek = True: Exit For
  Next i
End Function

a potom z listu lze volat, priklad:

Kód: Vybrat vše

=JeSvatek(D9)

[atari]

(ta posledni procedura je funkce - Function, takze ne Sub Function) jo jasně, to jsem to popletl...
Ta funkce také super - díky za ní
Ještě otázka:
Pokud v budoucnu přibude nějaký svátek (parlament něco schválí), tak jestli jsem to dobře pochopil, tak stačí do tohoto řádku dopsat další datum, a již nikde nic nemusím dalšího opravovat. Je to tak?

Kód: Vybrat vše

      ArrSvatky = Array("1.1.", "1.5.", "8.5.", "5.7.", "6.7.", "28.9.", "28.10.", _
          "17.11.", "24.12.", "25.12.", "26.12.")

[navstevnik]

Ano, staci doplnit pridany svatek.
Nastane vsak problem s platnosti pro roky pred zmenou. Pri pouzit na predchozi roky bude nutne pole ArraySvatky nacitat podle roku, pouzit Selec Case, (napriklad takto v roce 2012):

Kód: Vybrat vše

  Select Case rok
    Case Is < 2011
      ArrSvatky = Array("1.1.", "1.5.", "8.5.", "5.7.", "6.7.", "28.9.", "28.10.", _
          "17.11.", "24.12.", "25.12.", "26.12.")
     Case Is < 2012  ' pro rok 2011 a dalsi  ukazkove pridan Silvestr
      ArrSvatky = Array("1.1.", "1.5.", "8.5.", "5.7.", "6.7.", "28.9.", "28.10.", _
          "17.11.", "24.12.", "25.12.", "26.12.", "31.12.")
     Case Is > 2011 ' pro rok 2012 a dalsi  ukazkove pridan 30.12.
      ArrSvatky = Array("1.1.", "1.5.", "8.5.", "5.7.", "6.7.", "28.9.", "28.10.", _
          "17.11.", "24.12.", "25.12.", "26.12.", "31.12.", "30.12.")
  End Select

[atari]

No to je nádhera, takový luxus jsem si ani nepředstavoval... . Děkuji

// Označeno za vyřešené
// mike007