none
Agrupar código VBA RRS feed

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

    segunda-feira, 2 de novembro de 2015 18:07

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

    terça-feira, 3 de novembro de 2015 23:58
  • 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!!!!

    domingo, 8 de novembro de 2015 20:28
  • Acho pertinente utilizar este tópico, qual exceção gostaria de acrescentar?

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

    terça-feira, 10 de novembro de 2015 02:37
    Moderador
  • 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
    sexta-feira, 13 de novembro de 2015 23:43
  • Desculpe, mas não entendi a exceção.

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

    segunda-feira, 16 de novembro de 2015 12:36
    Moderador
  • 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!!!!

    terça-feira, 17 de novembro de 2015 17:12