Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
deletar linhas dos ...
 
Notifications
Clear all

deletar linhas dos dois extremos de uma planilha c criterios

 
2024 - VBA & Macros
Post Recente por brunsftw 9 anos atrás
8 Posts
3 Usuários
0 Reactions
1,434 Visualizações
RSS
 brunsftw
(@brunsftw)
Posts: 93
Estimable Member
Topic starter
 

Boa tarde!
Tô aqui de novo pedindo a ajuda de vocês.
Eu tenho uma planilha que é gerada mensalmente com uma determinada quantidade de linhas. No arquivo em anexo eu conto com 4630 linhas, mas esse valor varia de mês para mês.
Eu precisaria de um código que criasse automaticamente mais uma aba no meu arquivo, chamada "-10%" e copiasse os dados da aba "Extremos" retirando 10% das linhas no extremo superior e 10% no extremo inferior.
Por exemplo:
Na aba "Extremos" eu tenho na coluna "A" com 4630 registros. Fazendo a conta "4630 * 10%" eu tenho o resultado 463. Então, da linha A1 até a linha A463 e da linha A4167 até a linha A4630, eu gostaria que elas fossem deletadas.
O único porém é que o numero de registros variam de mês a mês e como eu preciso automatizar esse processo, queria um meio que facilitasse isso pra mim.
Ajuda? haha

extremos.xlsx
 
Postado : 22/10/2015 1:34 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Alem da qtd de linhas existe outro criterio que permita a pesquisa??????????

 
Postado : 22/10/2015 1:38 pm
 brunsftw
(@brunsftw)
Posts: 93
Estimable Member
Topic starter
 

Seria só pela quantidade linhas mesmo. :S

 
Postado : 22/10/2015 1:42 pm
 brunsftw
(@brunsftw)
Posts: 93
Estimable Member
Topic starter
 

Ainda tô quebrando a cabeça. Alguém? :oops:

 
Postado : 23/10/2015 1:01 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Tente essa gambiarra

Option Explicit

Sub AleVBA_17812()
    Dim lastrow As Long
    'lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Application.ScreenUpdating = False
        Worksheets("-10%").Cells.Delete
        With Worksheets("Extremos")
            .Activate
            .AutoFilterMode = False
            [A1].Value = "AleVBA"
            [B1].Value = "AleVBA1"
            [C1].Value = "AleVBA2"
            With Range("C2")
                .Formula = "=IF(COUNTA(A:A)*10%,IF(ROW(A1)>COUNTA(A:A)*10%,9,1))&IF(COUNTA(A:A)*90%,IF(ROW(A1)>COUNTA(A:A)*90%,9,2))"
                With .Resize(Range("A" & Rows.Count).End(xlUp).Row - 1)
                    .FillDown
                    .Copy
                    .PasteSpecial xlPasteValues
                End With
            End With
            lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("$A$1:$C$" & lastrow).AutoFilter Field:=3, Criteria1:=Array("92"), Operator:=xlFilterValues
            .Range("A2:C" & lastrow).Copy Sheets("-10%").Range("A1")
        End With
        Application.CutCopyMode = False
        
        With Worksheets("-10%")
            .Activate
            Range("A1:C1").EntireColumn.AutoFit
        End With
    Application.ScreenUpdating = True

End Sub
 
Postado : 23/10/2015 2:05 pm
 brunsftw
(@brunsftw)
Posts: 93
Estimable Member
Topic starter
 

Valeeeeu! Adaptei e funcionou certinho!

 
Postado : 27/10/2015 6:48 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Fico feliz em ajudar, se foi útil, favor clicar na mãozinha!!

Att

 
Postado : 27/10/2015 6:54 am
 brunsftw
(@brunsftw)
Posts: 93
Estimable Member
Topic starter
 

Só mais uma pequena duvida:
Caso eu queira mudar a porcentegem para 5%, onde eu deveria mudar na fórmula?

 
Postado : 27/10/2015 7:14 am
Forum Jump:
  Tópico Anterior
Próximo Tópico