Agrupar código VBA

Question

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!!!!

Answer 1

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!!!!

Answer 2

Muito bom mesmo...aja até coloquei para outras sequencias...

Se eu colocar algumas exceções onde poderia inserir?

*ou tenho de abrir outro topico?

---

Server 2008......show!!!!

Answer 3

Acho pertinente utilizar este tópico, qual exceção gostaria de acrescentar?

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

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!!!!

Answer 5

Desculpe, mas não entendi a exceção.

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 6

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!!!!