CRIAR FUN?ÃO PARA CONTAR MAIOR SEQUÊNCIA NÊMERICA

JAKSONLZ 24/02/2017 12:37:48
#471923
Olá Pessoal!
Preciso de uma ajuda para escrever uma função pra contar a maior sequência de números dentro de um
Array do Tipo Variant...

Exemplo:

Tenho uma Sequencia do tipo
MyArray(1) = 3
MyArray(2) = 4
MyArray(3) = 5
MyArray(4) = 9
MyArray(5) = 11
MyArray(6) = 15 [ô]//maior sequência inicia aqui
MyArray(7) = 16
MyArray(8) = 17
MyArray(9) = 18
MyArray(10) = 19
MyArray(11) = 20
MyArray(12) = 21 [ô]//termina aqui
MyArray(13) = 23
MyArray(14) = 24
MyArray(15) = 25
MyArray(16) = 26
MyArray(17) = 28
MyArray(18) = 35

Retorno da Função = 7

Obs: O Array será Unidimensional, e o Tamanho será variável, + ou - até uns 23 elementos

Exemplo de Uso:

Private Sub ContarSequencial()
Dim sCountSequencial As Long
MyArray(1) = 3
MyArray(2) = 4
MyArray(3) = 5
MyArray(4) = 9
MyArray(5) = 11
MyArray(6) = 15 [ô]//maior sequência inicia aqui
MyArray(7) = 16
MyArray(8) = 17
MyArray(9) = 18
MyArray(10) = 19
MyArray(11) = 20
MyArray(12) = 21 [ô]//termina aqui
MyArray(13) = 23
MyArray(14) = 24
MyArray(15) = 25
MyArray(16) = 26
MyArray(17) = 28
MyArray(18) = 35


sCountSequencial = CountSequenciais(MyArray)
[ô]Retorno da Função = 7

if sCountSequencial <> 0 then
[ô]//Aqui vai o Código
end if

End Sub

[ô]///Exemplo do Ínicio da Função, NÃO Finalizada...
Public Function CountSequenciais(ByVal strNumber As Variant) As Long
Dim LenNumber As Long
Dim lenLoop As Long, lenSeq As Long
Dim strSeq As Long
dim strMaximo as Long

strMaximo = Ubound(strNumber)

For lenLoop = 1 To strMaximo

strSeq = strNumber(lenLoop)

If strSeq = lenLoop Then
lenSeq = lenSeq + 1
End If

Next lenLoop

CountSequenciais = lenSeq
End Function
TUNUSAT 24/02/2017 16:19:33
#471929 Resposta escolhida
JAKSONLZ,

Sinceramente não entendi muito bem o que você quer fazer, mas usando a explicação da página abaixo:

===================================================

Define VB6 procedure arguments with the ParamArray keyword

http://www.techrepublic.com/article/define-vb6-procedure-arguments-with-the-paramarray-keyword/

====================================================

 [ô]///Exemplo do Ínicio da Função, NÃO Finalizada...
Private Function CountSequenciais(ParamArray strNumber() As Variant) As Long
    Dim LenNumber As Long
    Dim lenLoop As Long
    Dim lenSeq As Long
    Dim strSeq As Long
    Dim strMaximo As Long
    
    strMaximo = UBound(strNumber)

    For lenLoop = 1 To strMaximo
    
    strSeq = strNumber(lenLoop)

        If strSeq = lenLoop Then
            lenSeq = lenSeq + 1
        End If

    Next lenLoop

    CountSequenciais = lenSeq

End Function



Modifiquei um pouco seu código.

[][ô]s,
Tunusat.
JAKSONLZ 24/02/2017 16:58:18
#471931
Obrigado por Responder....mais na verdade não intendi direito sua função, parece que simplesmente você alterou a forma de preencher o Array, mais daí pra mim não está funcionando....eu preciso saber qual a maior sequência de Números que existe no Array, por exemplo: ele começa com 3,4,5... está parte tem 3 números sequenciais, se fosse terminar aqui o tamanho do Array, o retorno da função seria =3, pois temos 3 números sequenciais...mais como o Array segue 3,4,5,[txt-color=#e80000]9[/txt-color] isso quer dizer que não está mais em sequência, por que pulou o ...6,7,8 e foi direto pro [txt-color=#e80000]9[/txt-color], mais como o Array é maior, lá na metade temos uma sequência maior de 7 números que é 15,16,17,18,19,20,21 ou seja está sequência é maior que a primeira encontrada, e é também a maior sequência de números dentro do Array, então o resultado esperado é = 7, que é o retorno final da Função...
TUNUSAT 24/02/2017 17:43:12
#471932
JAKSONLZ,

Acho que entendi agora.
Eu montei o código abaixo às pressas, por isso acho que dá para enxugar bastante as variáveis abaixo. Mas retornou [Ô]7[Ô]...
... veja se é isso que você quer.

  
Option Explicit
Option Base 1

Private Sub ContarSequencial()

    Dim sCountSequencial As Long
      Dim answer As Long
    Dim MyArray(20) As Integer
  
    MyArray(1) = 3
    MyArray(2) = 4
    MyArray(3) = 5
    MyArray(4) = 9
    MyArray(5) = 11
    MyArray(6) = 15 [ô]//maior sequência inicia aqui
    MyArray(7) = 16
    MyArray(8) = 17
    MyArray(9) = 18
    MyArray(10) = 19
    MyArray(11) = 20
    MyArray(12) = 21 [ô]//termina aqui
    MyArray(13) = 23
    MyArray(14) = 24
    MyArray(15) = 25
    MyArray(16) = 26
    MyArray(17) = 28
    MyArray(18) = 35

    answer = CountSequenciais(MyArray)
    [ô]Retorno da Função = 7

    If sCountSequencial <> 0 Then
        [ô]//Aqui vai o Código
    End If

End Sub

[ô]///Exemplo do Ínicio da Função, NÃO Finalizada...
Private Function CountSequenciais(ParamArray strNumber() As Variant) As Long
    Dim LenNumber As Long
    Dim lenLoop As Long
    Dim lenSeq As Long
    Dim strSeq As Long
    Dim lngSeq As Long
    Dim strMaximo As Long
    Dim lngPosMenor As Long
    Dim lngPosMaior As Long
    Dim lngDiferenca As Long
    
    lngPosMenor = 0
    lngPosMaior = 1
    lngDiferenca = 0
    
    strMaximo = UBound(strNumber(0))

    lngSeq = strNumber(0)(1)
    
    For lenLoop = 2 To strMaximo
    
        strSeq = strNumber(0)(lenLoop)

        If strSeq <> lngSeq + 1 Then
            
            If lngPosMenor < lngPosMaior Then
                lngPosMenor = lenLoop
            ElseIf lngPosMenor > lngPosMaior Then
                lngPosMaior = lenLoop
                
                If lngDiferenca < lngPosMaior - lngPosMenor Then
                    lngDiferenca = lngPosMaior - lngPosMenor
                End If
                
            End If
            
        End If

        lngSeq = strNumber(0)(lenLoop)
    Next lenLoop

    CountSequenciais = lngDiferenca

End Function



[][ô]s,
Tunusat.
JAKSONLZ 24/02/2017 23:05:09
#471935
Viu parece que para o exemplo funcionou...mais se eu alterar os dados para :

 
    MyArray(1) = 1
    MyArray(2) = 2
    MyArray(3) = 4
    MyArray(4) = 6       [ô]//maior sequência inicia aqui
    MyArray(5) = 7
    MyArray(6) = 8   
    MyArray(7) = 9       [ô]//termina aqui
    MyArray(8) = 11
    MyArray(9) = 14
    MyArray(10) = 17
    MyArray(11) = 20
    MyArray(12) = 21   
    MyArray(13) = 23
    MyArray(14) = 25
    MyArray(15) = 27
    MyArray(16) = 31
    MyArray(17) = 33
    MyArray(18) = 35

    [ô]Retorno esperado = 4

Mais está Retornando = 1....ta faltando alguma coisa...vou dar uma olhada com calma como você fez, pra mim tentar descobrir onde pode estar o erro, aí conversamos...obrigado por enquanto amigo...
JAKSONLZ 25/02/2017 10:25:31
#471939
Amigo ainda não está servindo pra todos os casos.....por exemplo 
 
    MyArray(1) = 1     [ô]//maior sequência inicia aqui
    MyArray(2) = 2
    MyArray(3) = 3
    MyArray(4) = 4      
    MyArray(5) = 5     [ô]//termina aqui
    MyArray(6) = 8   
    MyArray(7) = 9       
    MyArray(8) = 11
    MyArray(9) = 14
    MyArray(10) = 17
    MyArray(11) = 20
    MyArray(12) = 21   
    MyArray(13) = 23
    MyArray(14) = 25
    MyArray(15) = 27
    MyArray(16) = 31
    MyArray(17) = 33
    MyArray(18) = 35

    [ô]Retorno esperado = 5


E está retornando = 2....vou fazer mais alguns testes pra verificar....
TUNUSAT 25/02/2017 11:04:00
#471940
JAKSONLZ,

Acertei com uma solução muito feia!

 Private Function CountSequenciais(ParamArray strNumber() As Variant) As Long
    Dim lngLoop As Long
    Dim lngCompara As Long
    Dim lngSeq As Long
    Dim lngPosMenor As Long
    Dim lngPosMaior As Long
    Dim lngDiferenca As Long
    Dim lngDiferencaAux As Long
    
    lngPosMenor = 0
    lngPosMaior = 1
    lngDiferenca = 0
    lngDiferencaAux = 1

    lngSeq = strNumber(0)(1)
    
    For lngLoop = 2 To UBound(strNumber(0))
    
        lngCompara = strNumber(0)(lngLoop)

        If lngCompara <> lngSeq + 1 Then
            
            If lngPosMenor < lngPosMaior Then
                lngPosMenor = lngLoop
            ElseIf lngPosMenor >= lngPosMaior Then
                lngPosMaior = lngLoop
                
                If lngDiferenca < lngPosMaior - lngPosMenor Then
                    lngDiferenca = lngPosMaior - lngPosMenor
                End If
                
                lngLoop = lngLoop - 1
            End If
        ElseIf lngPosMenor = 0 Then
            lngDiferencaAux = lngDiferencaAux + 1
        End If

        lngSeq = strNumber(0)(lngLoop)
    Next
    
    If lngDiferencaAux > lngDiferenca Then
        lngDiferenca = lngDiferencaAux
    End If
    
    CountSequenciais = lngDiferenca
End Function



[][ô]s,
Tunusat.
JAKSONLZ 25/02/2017 11:18:39
#471941
Citação:

:
Acertei com uma solução muito feia!



kkkkkk
Esta parece que deu certo....fiz uns 5 testes e parece que funciona direitinho....muito Obrigado!!!!!
TUNUSAT 25/02/2017 11:20:53
#471942
JAKSONLZ,

Acho que ficou bem melhor!!!

 Private Function CountSequenciais(ParamArray strNumber() As Variant) As Long
    Dim lngLoop As Long
    Dim lngCompara As Long
    Dim lngSeq As Long
    Dim lngDiferenca As Long
    Dim lngDiferencaAux As Long

    lngDiferenca = 0
    lngDiferencaAux = 1

    lngSeq = strNumber(0)(1)
    
    For lngLoop = 2 To UBound(strNumber(0))
    
        lngCompara = strNumber(0)(lngLoop)

        If lngCompara = lngSeq + 1 Then

            lngDiferencaAux = lngDiferencaAux + 1
            
            If lngDiferencaAux > lngDiferenca Then
                lngDiferenca = lngDiferencaAux
            End If
            
        Else
            lngDiferencaAux = 1
        End If

        lngSeq = strNumber(0)(lngLoop)
    Next
    
    CountSequenciais = lngDiferenca
End Function



[][ô]s,
Tunusat.
JAKSONLZ 25/02/2017 11:35:16
#471943
Citação:

:
Acho que ficou bem melhor!!!




HÃ HÃÃ...Ficou blza, Muito Obrigado meu amigo.....vou finalizar o Tópico...
TUNUSAT 25/02/2017 11:37:30
#471944
JAKSONLZ,

OKay, mas testa mais.

[][ô]s,
Tunusat.
Tópico encerrado , respostas não são mais permitidas
Voltar