Oi!

Encontrei um post cujo assunto é "erro na função - urgente", colocada nesse forúm dia 31/08/2005.

Nele há essa função de dia util bem completa,porém está  retornando data bem malucas.

Se alguém puder me ajudar, ficarei grata.

 

Function spf_calcula_dia_util(slv_Data As String) As Date
Dim A, B, c, D, E, F, G, H, I, K, L, m, p, Q As Long, Ano, dt_Pascoa, dt_Carnaval, dt_SextaSanta, dt_CorpusC As Date
  'Função que calcula Feriados móveis
  Ano = Year(CDate(slv_Data))
  A = (Ano Mod 19)
  B = Int(Ano / 100)
  c = (Ano Mod 100)
  D = Int(B / 4)
  E = (B Mod 4)
  F = Int((B + 8) / 25)
  G = Int((B - F + 1) / 3)
  H = ((19 * A + B - D - G + 15) Mod 30)
  I = Int(c / 4)
  K = (c Mod 4)
  L = ((32 + 2 * E + 2 * I - H - K) Mod 7)
  m = Int((A + 11 * H + 22 * L) / 451)
  p = Int((H + L - 7 * m + 114) / 31)
  Q = ((H + L - 7 * m + 114) Mod 31)
 
  dt_Pascoa = CDate((Q + 1) & "/" & p & "/" & Ano)
  dt_Carnaval = DateAdd("d", -47, dt_Pascoa)
  dt_SextaSanta = DateAdd("d", -2, dt_Pascoa)
  dt_CorpusC = DateAdd("d", 60, dt_Pascoa)
  If Weekday(CDate(slv_Data)) <> 1 Then 'Domingo
   If Weekday(CDate(slv_Data)) <> 7 Then 'Sábado
    If CDate(slv_Data) <> dt_Pascoa Then 'Pascoa
     If CDate(slv_Data) <> dt_Carnaval Then 'Carnaval
      If CDate(slv_Data) <> dt_SextaSanta Then 'Sexta Santa
       If CDate(slv_Data) <> dt_CorpusC Then 'Corpus Cristh
        If Month(CDate(slv_Data)) = 1 And Day(CDate(slv_Data)) = 1 Then
          spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Confratenização Universal
       
        ElseIf CDate(slv_Data) = dt_Carnaval + 1 Then
          spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'quarta feira de cinzas
       
        ElseIf Month(CDate(slv_Data)) = 4 And Day(CDate(slv_Data)) = 21 Then
         spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'tiradentes
       
        ElseIf Month(CDate(slv_Data)) = 5 And Day(CDate(slv_Data)) = 1 Then
          spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'dia do trabalho
       
        ElseIf Month(CDate(slv_Data)) = 9 And Day(CDate(slv_Data)) = 7 Then
         spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'independencia
              
        ElseIf Month(CDate(slv_Data)) = 10 And Day(CDate(slv_Data)) = 12 Then
         spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'N. S. Aparecida
       
        ElseIf Month(CDate(slv_Data)) = 11 And Day(CDate(slv_Data)) = 2 Then
         spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Finados
       
        ElseIf Month(CDate(slv_Data)) = 11 And Day(CDate(slv_Data)) = 15 Then
         spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Proclamação Republica
       
        ElseIf Month(CDate(slv_Data)) = 12 And Day(CDate(slv_Data)) = 25 Then
        spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Natal
       
        End If
       Else
        spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Corpus Cristh
       End If
      Else
       spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Sexta Santa
      End If
     Else
      spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Carnaval
     End If
    Else
    spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Pascoa
    End If
   Else
    spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Sábado
   End If
  Else
  spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Domingo
  End If
 
End Function

 

 

 

 

este exemplo serve para encontrar o 5 dia útil após uma data ... por exemplo se você colocar a data 24/02/2006 a função vai retornar 06/03/2006 ... para testar é só criar um form com um textbox e um botão colocar uma data no textbox ...

 

Private Sub Command1_Click()
 Dim dt_Pascoa As Variant 'feriado de páscoa
 Dim dt_Carnaval As Variant 'feriado de carnaval
 Dim dt_SextaSanta As Variant 'feriado de sexta-feira santa
 Dim dt_CorpusC As Variant 'feriado corpus cristi
 Dim Data As Variant 'data informada pelo usuário
 Dim diautil As Integer 'variavel de controle -> 5 dias úteis
 Dim dataaux As Date 'data após x dias úteis (x = diautil)
 Data = Format(CDate(Text1.Text), "dd/mm/yyyy")
 subFeriadosMoveis Year(Data), dt_Pascoa, dt_Carnaval, dt_SextaSanta, dt_CorpusC
 
diautil = 0
dataaux = Data
Do While diautil < 5
  dataaux = DateAdd("d", 1, dataaux)
  If (Weekday(dataaux) <> 1) And (Weekday(dataaux) <> 7) Then 'se dia não for sábado ou domingo
    If (dataaux <> dt_Pascoa) And (dataaux <> dt_Carnaval) And (dataaux <> dt_SextaSanta) And (dataaux <> dt_CorpusC) Then 'se dia não for feriado
      diautil = diautil + 1 'se for dia útil conta o dia
    End If
  End If
Loop

MsgBox dataaux

End Sub

Private Sub subFeriadosMoveis(ByVal Ano As Long, ByRef dt_Pascoa As Variant, ByRef dt_Carnaval As Variant, ByRef dt_SextaSanta As Variant, ByRef dt_CorpusC As Variant)
'Esta função calcula os feriados móveis nacionais:
'Pascoa, Carnaval, Sexta-Feira Santa e CorpusC.

     Dim A, B, C, D, E, F, G, H, I, K, L, M, P, Q As Long
     A = (Ano Mod 19)
     B = Int(Ano / 100)
     C = (Ano Mod 100)
     D = Int(B / 4)
     E = (B Mod 4)
     F = Int((B + 8) / 25)
     G = Int((B - F + 1) / 3)
     H = ((19 * A + B - D - G + 15) Mod 30)
     I = Int(C / 4)
     K = (C Mod 4)
     L = ((32 + 2 * E + 2 * I - H - K) Mod 7)
     M = Int((A + 11 * H + 22 * L) / 451)
     P = Int((H + L - 7 * M + 114) / 31)
     Q = ((H + L - 7 * M + 114) Mod 31)
   
     dt_Pascoa = CDate((Q + 1) & "/" & P & "/" & Ano)
     dt_Carnaval = DateAdd("d", -47, dt_Pascoa)
     dt_SextaSanta = DateAdd("d", -2, dt_Pascoa)
     dt_CorpusC = DateAdd("d", 60, dt_Pascoa)

End Sub

 

martini naum sei se vc notou mais a funcou q a clau passou eh um aperfeiçoamento da sua, sou eu o dono do post, clau vou te add no msn e te passo por um email q vc informar...

Fiz um exemplo não tão eficiente porem bem simple, se você quiser ver ele esta em:

Cara, resolvi testas a função.

 

veja como ficou.

 

 

 

 

Function spf_calcula_dia_util(slv_Data As String) As Date
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, G As Long
    Dim H As Long, I As Long, K As Long, L As Long, M As Long, P As Long, Q As Long
    Dim Ano As String
    Dim dt_Pascoa As Date, dt_Carnaval As Date, dt_SextaSanta As Date, dt_CorpusC As Date

    'Função que calcula Feriados móveis
   
    spf_calcula_dia_util = slv_Data
   
    Ano = Year(CDate(slv_Data))
    A = (Ano Mod 19)
    B = Int(Ano / 100)
    C = (Ano Mod 100)
    D = Int(B / 4)
    E = (B Mod 4)
    F = Int((B + 8) / 25)
    G = Int((B - F + 1) / 3)
    H = ((19 * A + B - D - G + 15) Mod 30)
    I = Int(C / 4)
    K = (C Mod 4)
    L = ((32 + 2 * E + 2 * I - H - K) Mod 7)
    M = Int((A + 11 * H + 22 * L) / 451)
    P = Int((H + L - 7 * M + 114) / 31)
    Q = ((H + L - 7 * M + 114) Mod 31)
 
    dt_Pascoa = CDate((Q + 1) & "/" & P & "/" & Ano)
    dt_Carnaval = DateAdd("d", -47, dt_Pascoa)
    dt_SextaSanta = DateAdd("d", -2, dt_Pascoa)
    dt_CorpusC = DateAdd("d", 60, dt_Pascoa)
   
   If Weekday(CDate(slv_Data)) <> 1 Then 'Domingo
    If Weekday(CDate(slv_Data)) <> 7 Then 'Sábado
      If CDate(slv_Data) <> dt_Pascoa Then 'Pascoa
       If CDate(slv_Data) <> dt_Carnaval Then 'Carnaval
        If CDate(slv_Data) <> dt_SextaSanta Then 'Sexta Santa
         If CDate(slv_Data) <> dt_CorpusC Then 'Corpus Cristh
          If Month(CDate(slv_Data)) = 1 And Day(CDate(slv_Data)) = 1 Then
            spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Confratenização Universal
         
          ElseIf CDate(slv_Data) = dt_Carnaval + 1 Then
            spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'quarta feira de cinzas
         
          ElseIf Month(CDate(slv_Data)) = 4 And Day(CDate(slv_Data)) = 21 Then
           spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'tiradentes
         
          ElseIf Month(CDate(slv_Data)) = 5 And Day(CDate(slv_Data)) = 1 Then
            spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'dia do trabalho
         
          ElseIf Month(CDate(slv_Data)) = 9 And Day(CDate(slv_Data)) = 7 Then
           spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'independencia
               
          ElseIf Month(CDate(slv_Data)) = 10 And Day(CDate(slv_Data)) = 12 Then
           spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'N. S. Aparecida
         
          ElseIf Month(CDate(slv_Data)) = 11 And Day(CDate(slv_Data)) = 2 Then
           spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Finados
         
          ElseIf Month(CDate(slv_Data)) = 11 And Day(CDate(slv_Data)) = 15 Then
           spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Proclamação Republica
         
          ElseIf Month(CDate(slv_Data)) = 12 And Day(CDate(slv_Data)) = 25 Then
          spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Natal
         
          End If
         Else
          spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Corpus Cristh
         End If
        Else
         spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Sexta Santa
        End If
       Else
        spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Carnaval
       End If
      Else
      spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Pascoa
      End If
     Else
      spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Sábado
     End If
    Else
    spf_calcula_dia_util = spf_calcula_dia_util(CDate(slv_Data) + 1) 'Domingo
    End If
 
End Function

tekki desulpa por naum avisar.... essa pergunta jah foi despondida da outra vez e jah acertei isso com a clau, vou avisar ela pra trancar o topico