Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Macro Pular Linha a...
 
Notifications
Clear all

Macro Pular Linha após sequência numérica

 
2024 - VBA & Macros
Post Recente por lauriano 9 anos atrás
6 Posts
4 Usuários
0 Reactions
1,414 Visualizações
RSS
 lauriano
(@lauriano)
Posts: 3
New Member
Topic starter
 

Senhores, bom dia!!

Tenho um arquivo bastante extenso que preciso inserir uma linha após uma sequencia de repetidos valores, e preciso muito da ajuda de vocês para criação de uma macro que resolva esse problema:

ANTES
2111355 2 D 10/01/2013
2111355 2 C 10/01/2013
2111356 2 D 09/01/2013
2111356 2 D 09/01/2013
2111356 2 C 09/01/2013
2111407 2 D 08/01/2013
2111407 2 C 08/01/2013
2111407 2 D 08/01/2013
2111423 2 C 31/01/2013
2111423 2 D 31/01/2013
2111429 2 C 31/01/2013
2111429 2 D 31/01/2013

DEPOIS (ESPERADO POR MACRO)
2111355 2 D 10/01/2013
2111355 2 C 10/01/2013

2111356 2 D 09/01/2013
2111356 2 D 09/01/2013
2111356 2 C 09/01/2013

2111407 2 D 08/01/2013
2111407 2 C 08/01/2013
2111407 2 D 08/01/2013

2111423 2 C 31/01/2013
2111423 2 D 31/01/2013

2111429 2 C 31/01/2013
2111429 2 D 31/01/2013

A primeira coluna é o número que se repete e quando não mais repetir, pular uma linha.

Desde já agradeço!!!

 
Postado : 03/07/2015 8:02 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

pode pelo menos colocar uma planilha de exemplo dos dados ?

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 03/07/2015 9:22 am
Issamu
 Issamu
(@issamu)
Posts: 605
Honorable Member
 

Use ou adapte a sua necessidade:

Sub inserir_Linha()
    Range("A3").Activate
    Do Until ActiveCell.Value = ""
        If ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value And _
            ActiveCell.Offset(-1, 0).Value <> "" Then
            ActiveCell.EntireRow.Insert
            ActiveCell.Offset(1, 0).Activate
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Loop
End Sub

Rafael Issamu F. Kamimura
Moderador Oficial Microsoft Community - MCC (Contribuidor do Microsoft Community)
http://zip.net/bjrt0X - http://zip.net/bhrvbR
Foi útil? Clique na mãozinha
Conheça: http://excelmaniacos.com/

 
Postado : 03/07/2015 10:06 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Considerando que os valores estão nas colunas A,B,C e D.

Sub AleVBA_16482()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 2 Step -1
        If Cells(i, "A").Value <> Cells(i - 1, "A") Then
        Cells(i, "A").EntireRow.Insert
    End If
Next i
Application.ScreenUpdating = True
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 03/07/2015 10:08 am
 lauriano
(@lauriano)
Posts: 3
New Member
Topic starter
 

Use ou adapte a sua necessidade:

Sub inserir_Linha()
    Range("A3").Activate
    Do Until ActiveCell.Value = ""
        If ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value And _
            ActiveCell.Offset(-1, 0).Value <> "" Then
            ActiveCell.EntireRow.Insert
            ActiveCell.Offset(1, 0).Activate
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Loop
End Sub

Usei da forma que está e resolveu 100%... Muito obrigado!!

 
Postado : 03/07/2015 11:03 am
 lauriano
(@lauriano)
Posts: 3
New Member
Topic starter
 

Boa tarde!!

Considerando que os valores estão nas colunas A,B,C e D.

Sub AleVBA_16482()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 2 Step -1
        If Cells(i, "A").Value <> Cells(i - 1, "A") Then
        Cells(i, "A").EntireRow.Insert
    End If
Next i
Application.ScreenUpdating = True
End Sub

Também funcionou 100% da forma que está! Muito Obrigado!!

Att

 
Postado : 03/07/2015 11:07 am
Forum Jump:
  Tópico Anterior
Próximo Tópico