Inquiridor
Agrupar código VBA

Pergunta
-
Olá pessoal,
Como poderia diminuir código abaixo?
*Ele elimina sequencia de numeros após entrar com primeiro valor.
------------------------
Sub eliminar()
Dim lLin As Long
Dim x As Integer
x = Application.InputBox("Digite o Primeiro numero da sequencia", "Application.InputBox", "Valor numérico", , , , , 1)
'MsgBox "O valor digitado foi: " & x
Application.ScreenUpdating = False
'Altere o nome da planilha abaixo:
With Sheets("Plan1")
'*********************COLUNA A
For lLin = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "A") = x _
And .Cells(lLin, "B") = x + 1 _
And .Cells(lLin, "C") = x + 2 _
And .Cells(lLin, "D") = x + 3 _
And .Cells(lLin, "E") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
'VAI PARA PROXIMA COLUNA
Next lLin
'*********************COLUNA B*************************************
For lLin = .Cells(.Rows.Count, "B").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "B") = x _
And .Cells(lLin, "C") = x + 1 _
And .Cells(lLin, "D") = x + 2 _
And .Cells(lLin, "E") = x + 3 _
And .Cells(lLin, "F") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'*********************COLUNA C*************************************
For lLin = .Cells(.Rows.Count, "C").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "C") = x _
And .Cells(lLin, "D") = x + 1 _
And .Cells(lLin, "E") = x + 2 _
And .Cells(lLin, "F") = x + 3 _
And .Cells(lLin, "G") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'*********************COLUNA D************************************
For lLin = .Cells(.Rows.Count, "D").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "D") = x _
And .Cells(lLin, "E") = x + 1 _
And .Cells(lLin, "F") = x + 2 _
And .Cells(lLin, "G") = x + 3 _
And .Cells(lLin, "H") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'********************COLUNA E*************************************
For lLin = .Cells(.Rows.Count, "E").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "E") = x _
And .Cells(lLin, "F") = x + 1 _
And .Cells(lLin, "G") = x + 2 _
And .Cells(lLin, "H") = x + 3 _
And .Cells(lLin, "I") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'*********************COLUNA F************************************
For lLin = .Cells(.Rows.Count, "F").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "F") = x _
And .Cells(lLin, "G") = x + 1 _
And .Cells(lLin, "H") = x + 2 _
And .Cells(lLin, "I") = x + 3 _
And .Cells(lLin, "J") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'********************COLUNA G*************************************
For lLin = .Cells(.Rows.Count, "G").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "G") = x _
And .Cells(lLin, "H") = x + 1 _
And .Cells(lLin, "I") = x + 2 _
And .Cells(lLin, "J") = x + 3 _
And .Cells(lLin, "K") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'********************COLUNA H*************************************
For lLin = .Cells(.Rows.Count, "H").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "H") = x _
And .Cells(lLin, "I") = x + 1 _
And .Cells(lLin, "J") = x + 2 _
And .Cells(lLin, "K") = x + 3 _
And .Cells(lLin, "L") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'*********************COLUNA I************************************
For lLin = .Cells(.Rows.Count, "I").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "I") = x _
And .Cells(lLin, "J") = x + 1 _
And .Cells(lLin, "K") = x + 2 _
And .Cells(lLin, "L") = x + 3 _
And .Cells(lLin, "M") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'********************COLUNA J*************************************
For lLin = .Cells(.Rows.Count, "J").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "J") = x _
And .Cells(lLin, "K") = x + 1 _
And .Cells(lLin, "L") = x + 2 _
And .Cells(lLin, "M") = x + 3 _
And .Cells(lLin, "N") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
'********************COLUNA K*************************************
For lLin = .Cells(.Rows.Count, "K").End(xlUp).Row To 1 Step -1
If .Cells(lLin, "K") = x _
And .Cells(lLin, "L") = x + 1 _
And .Cells(lLin, "M") = x + 2 _
And .Cells(lLin, "N") = x + 3 _
And .Cells(lLin, "O") = x + 4 _
Then .Rows(lLin).Delete
'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas:
If lLin Mod 100 = 0 Then DoEvents
Next lLin
End With
'**********************
Application.ScreenUpdating = True
End Sub=====================
com outras funcionalidades fiaria ENORMEEEEE!!!!
OBRIGADO
Server 2008......show!!!!
- Movido AndreAlvesLima quarta-feira, 4 de novembro de 2015 08:38
Todas as Respostas
-
Mestre Filipe Magno resolveu!!!
==========
Sub eliminar() Dim lLin As Long Dim x As Integer Dim Col As Long x = Application.InputBox("Digite o Primeiro numero da sequencia", "Application.InputBox", "Valor numérico", , , , , 1) 'MsgBox "O valor digitado foi: " & x Application.ScreenUpdating = False 'Altere o nome da planilha abaixo: With Sheets("Plan1") For Col = 1 To 11 For lLin = .Cells(.Rows.Count, Col).End(xlUp).Row To 1 Step -1 If .Cells(lLin, Col) = x _ And .Cells(lLin, Col + 1) = x + 1 _ And .Cells(lLin, Col + 2) = x + 2 _ And .Cells(lLin, Col + 3) = x + 3 _ And .Cells(lLin, Col + 4) = x + 4 _ Then .Rows(lLin).Delete 'Desafoga os processos pendentes do Windows a cada 100 linhas iteradas: If lLin Mod 100 = 0 Then DoEvents 'VAI PARA PROXIMA COLUNA Next lLin Next Col Application.ScreenUpdating = True End Sub
============
Showw..funcionou muito bem
Server 2008......show!!!!
-
-
-
olá....
Na verdade serao varias exceções para a seleção informada.
como irei estar pensando nas diversas qu imagino, teria de ter ideia de onde posiciona-la neste código acima.
Por ex.:
- Não listar sequencias em seguidas de 01 em 01 em 7 numeros informados.
Assim: na linha 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15....não seria mostrada pois tem sequencia de 1 em 1 até mais de 7 numeros; outro 1,2,3,4,5,6,15,14,19,20,21,22,23,24,25...não entraria pois apartir do 19 se repetiu de 1 em 1 7x...
Essa seria uma exceção.
Obrigado
Server 2008......show!!!!
- Editado Edgolveiabol sexta-feira, 13 de novembro de 2015 23:43 agradecimento
-
-
Seguinte. Pela geração dos milhares números da combinação a idéia é criar filtros de tal forma que "estas exceções" não sejam listadas. Serão várias exceções... Porém não vi onde coloca-las...e nem criar.
E este exemplo que enviei seria sequencias seguidas de 7 numeros.
Ex: Toda linha de 15 numeros que ocorrer sequencias de 1 em 1 totalizando 7 numeros, não seria listado na tela... Idéia central destas exceções sera diminuir ao maximo essa quantidade de 3 milhoes de combinações possiveis.
Obirgado
Server 2008......show!!!!