Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Auto-Filtro com Intervalo de Tempo maior que 24h

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
LCAntunes
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Dom Mai 03, 2020 12:31 am

Auto-Filtro com Intervalo de Tempo maior que 24h

Mensagem por LCAntunes »

Prezados, bom dia!

Sou novo no forum, mas já dei uma buscada pelos tópicos, sem encontrar a solução. A questão é a seguinte: tenho uma base na qual tenho que tratar outliers. Tenho vetores dos dados, com limites superiores e inferiores que tenho que buscar valores de intervalo de tempo, geralmente maiores do que 24h. A questão é que não consigo realizar esse autofiltro com intervalo e esses valores acima de 24h. Já tentei colocar dois códigos de funções, que são os seguintes:

Código: Selecionar todos

Function FormatInterval(ByVal Interval As Variant, Fmt As String)

Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long
If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then
Exit Function

'Days
'Days = Int(Interval)
'Interval = Interval - Days
'
'If Interval > #11:59:59 PM# Then
'Days = Days + 1
'Interval = 0
'End If

'Houras
'Interval = Interval * 24
Hours = Int(Interval)
Interval = Interval - Hours

If Interval > 3599# / 3600# Then
Hours = Hours + 1
Interval = 0#
End If

'Minutos
Interval = Interval * 60
Minutes = Int(Interval)
Interval = Interval - Minutes

If Interval > 59# / 60# Then
Minutes = Minutes + 1
Minutes = 0#
End If

'Segundos
Seconds = Int(Interval * 60 + 0.5)

If Seconds = 60 Then
Minutes = Minutes + 1
Seconds = 0
End If

If Minutes > 59 Then
Hours = Hours + 1
Minutes = Minutes - 60
End If

'If Hours > 23 Then
'Days = Days + 1
'Hours = Hours - 24
'End If

Select Case Fnt

Case "[h]:mm:ss"
'Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")

Case "[hh]:mm:ss"
'Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")

Case Else
FormatInterval = Null

End Select
End If
End Function
O outro eu mesmo montei, é assim:

Código: Selecionar todos

Function FormatarTempo(ByVal Intervalo As Variant, frm As String)
    Dim hora As Variant, minuto As Variant, segundo As Variant
    
    hora = Int(Intervalo * 24) ' calculada qtas horas
    minuto = Int((Intervalo * 24 - Int(Intervalo * 24)) * 60) 'calculado qtde minutos
    segundo = ((Intervalo * 24 - Int(Intervalo * 24)) * 60 - Int((Intervalo * 24 - Int(Intervalo * 24)) * 60)) * 60
    If segundo >= 59.5 Then
    segundo = 0
    minuto = minuto + 1
    End If
    
    If minuto >= 59.5 Then
    minuto = 0
    hora = hora + 1
    End If
    
    Select Case frm

    Case "[h]:mm:ss"
    FormatarTempo = Format(hora, "00") & ":" & Format(minuto, "00") & ":" & Format(segundo, "00")
    Case "[hh]:mm:ss"
    FormatarTempo = Format(hora, "00") & ":" & Format(minuto, "00") & ":" & Format(segundo, "00")
    Case Else
    FormatarTempo = Null
    End Select
    
End Function


Basicamente, o meu filtro pega os seguintes valores:

Código: Selecionar todos

 ActiveSheet.Range("$A$1:$Z$" & lin3).AutoFilter Field:=17, Criteria1:=">=" & sup(i), Operator:=xlOr, Criteria2:="<" & inf(4)
    ActiveSheet.Range("A1:Z" & Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=Sheets("OUT" & i).Range("A" & Sheets("OUT" & i).Cells(Rows.Count, "A").End(xlUp).Row)

Conseguem me dar uma mão? Já estou quebrando cabeça com isso há alguns dias, sem sucesso. Vou anexar o código inteiro aqui.

Agradeço!
Script.zip
(4.03 KiB) Baixado 204 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder