Notifications
Clear all

Localizar sequencias na lista e retornar total

6 Posts
2 Usuários
0 Reactions
1,681 Visualizações
(@dimorais)
Posts: 431
Reputable Member
Topic starter
 

Boa tarde
Preciso localizar uma lista de sequencias dentro de uma lista maior e retornar somente os totais de cada sequencia. Mais uma vez grato, se puderem ajudar. :D

 
Postado : 26/11/2015 12:28 pm
(@suggos)
Posts: 111
Estimable Member
 

Olá!

O código abaixo faz a contagem. Pode demorar um pouco dependendo do processamento do seu computador, mas vai aparecer o percentual concluído na barra de status para que você saiba se o programa travou ou não.

Os números de sequências não bateram com os que você informou. Você tem certeza de que estão certos?

Sub contar()

Dim lin1, lin2, i As Integer

Application.ScreenUpdating = False
Application.DisplayStatusBar = True

lin1 = Range("P1048576").End(xlUp).Row
lin2 = Range("D1048576").End(xlUp).Row

For i = 3 To lin2
    Range("Y3:Z" & lin1).FormulaLocal = "=SEERRO(CORRESP(VALOR(C$" & i & ");$I3:$W3;0);Z3+1)"
    Range("AA3:AA" & lin1).FormulaLocal = "=SEERRO(CORRESP(VALOR(E$" & i & ");$I3:$W3;0);0)"
    Range("AB3:AB" & lin1).FormulaLocal = "=SE(E(AA3>Z3;Z3>Y3);1;0)"
    Range("G" & i) = Application.WorksheetFunction.Sum(Range("AB3:AB" & lin1))
    
    Application.StatusBar = Int(i / lin2 * 100) & "%"
Next

Range("Y:AB").EntireColumn.Delete

Application.StatusBar = False

End Sub

Não se esqueça de marcar o tópico como resolvido se a resposta for satisfatória.

 
Postado : 26/11/2015 7:45 pm
(@dimorais)
Posts: 431
Reputable Member
Topic starter
 

Suggos, grato por responder. :D
O raciocínio foi baseado em:
A - A tabela tem 15 colunas;
B - Quantas combinações de 3 números podem ser formados com 20 números;
C - Usei a formula, Combin(20:3) = 1.140
D - Menor numero 1, Maior 20
Se faltou alguma coisa, por favor, pode acrescentar.

 
Postado : 27/11/2015 5:42 am
(@dimorais)
Posts: 431
Reputable Member
Topic starter
 

Só mais uma coisa, no arquivo postado são três valores a ser pesquisado, mas como fazer se forem dois, quatro ou mais valores. Em qual(is) linha(s) devo alterar?

 
Postado : 27/11/2015 7:05 am
(@suggos)
Posts: 111
Estimable Member
 

A tabela da esquerda contém todos as sequências possíveis de 20 números unidos 3 a 3. A da direita não deveria ter todos as sequências de 20 números unidos 15 a 15? Se sim a da direita está incompleta.

O código abaixo faz a contagem para qualquer quantidade de números na tabela da esquerda (2, 3, 4, etc.). Adotei as seguintes premissas:
1 - Haverá apenas uma coluna entre a tabela da esquerda e a da direita.
2 - A tabela da direita sempre terá 15 colunas.
3 - O espaço à direita da tabela de 15 colunas estará sempre vazio.
4 - A tabela da esquerda sempre se iniciará na coluna C.
5 - Ambas tabelas se iniciarão na terceira linha.

Sub contar()

Dim lin1, lin2, i, n As Integer
Dim criterios As String

Application.ScreenUpdating = False
Application.DisplayStatusBar = True

n = Range("C3", Range("C3").End(xlToRight)).Count
lin1 = Range("P1048576").End(xlUp).Row
lin2 = Range("D1048576").End(xlUp).Row
criterios = ""

For i = 1 To n - 1
    criterios = criterios & "RC[-" & i & "]>RC[-" & i + 1 & "],"
Next

If n > 2 Then
    criterios = "AND(" & Mid(criterios, 1, Len(criterios) - 1) & ")"
Else
    criterios = Mid(criterios, 1, Len(criterios) - 1)
End If

For i = 3 To lin2
    Range(Cells(3, 22 + n), Cells(lin1, 22 + 2 * n - 2)).FormulaR1C1 = _
        "=IFERROR(MATCH(VALUE(R" & i & "C[-" & n + 19 & "]),RC" & n + 6 & ":RC" & n + 20 & ",0),RC[1]+1)"
    Range(Cells(3, 22 + 2 * n - 1), Cells(lin1, 22 + 2 * n - 1)).FormulaR1C1 = _
        "=IFERROR(MATCH(VALUE(R" & i & "C[-" & n + 19 & "]),RC" & n + 6 & ":RC" & n + 20 & ",0),0)"
    Range(Cells(3, 22 + 2 * n), Cells(lin1, 22 + 2 * n)).FormulaR1C1 = "=IF(" & criterios & ",1,0)"
    Cells(3, 22 + 2 * n).Select
    Cells(i, n + 4) = Application.WorksheetFunction.Sum(Range(Selection, Selection.End(xlDown)))
    
    Application.StatusBar = Int(i / lin2 * 100) & "%"
Next

Range(Cells(, 22 + n), Cells(, 22 + 2 * n)).EntireColumn.Delete

Application.StatusBar = False

End Sub

Não se esqueça de marcar o tópico como resolvido se a resposta for satisfatória.

 
Postado : 29/11/2015 3:36 pm
(@dimorais)
Posts: 431
Reputable Member
Topic starter
 

"A da direita não deveria ter todos as sequências de 20 números unidos 15 a 15? Se sim a da direita está incompleta."
A lógica adotada é essa mesmo. Agradeço a colaboração e explicação nas duas soluções postada. :D :D :D

 
Postado : 29/11/2015 3:45 pm