VBA Excel - Deletando linhas duplicadas - Delete duplicate rows

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

Vez por outra colamos bases de dados no MS Excel para efetuarmos análises, e sem que nos apercebamos, ou devido a uma base mal consolidada, encontramos os dados duplicados.
Como efetuar uma depuração que retire as ocorrências duplicadas deixando somente uma versão de cada registro?
A solução abaixo é o resultado de tal necessidade. 

Public Sub DelDupliRows (rng As Range)' Author:                  Date:                   Contact:' André Bernardes 29/01/2009 12:18 bernardess@gmail.com' Esta SUB deletará registros (linhas) duplicadas, será baseada no Range passado' como parâmetro. Quando esta SUB achar mais duma ocorrência no mesmo Range,' todas as ocorrências seguintes serão deletadas.
Dim r As LongDim n As LongDim v As Variant
On Error GoTo EndMacro
Let Application.ScreenUpdating = FalseLet Application.Calculation = xlCalculationManualLet Application.StatusBar = "Linha sendo processada: " & _ Format(rng.Row, "#,##0")
Let n = 0
For r = rng.Rows.Count To 2 Step -1If r Mod 500 = 0 ThenLet Application.StatusBar = "Processing Row: " & Format(r, "#,##0")End If
Let v = rng.Cells(r, 1).Value
If v = vbNullString ThenIf Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Thenrng.Rows(r).EntireRow.DeleteLet n = n + 1End IfElseIf Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Thenrng.Rows(r).EntireRow.DeleteLet n = n + 1End IfEnd IfNext r
EndMacro:Let Application.StatusBar = FalseLet Application.ScreenUpdating = TrueLet Application.Calculation = xlCalculationAutomatic
MsgBox CStr(n) & "Linha(s) Duplicada(s) Deleta(s) "End Sub

Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...

Tags: VBA, Excel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines, duplicate, duplicado, dados, paste, cut

Excel Tips - Excluindo linhas em branco ao abrir a Planilha - Removing Blank Rows Automatically

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

O que é o fenômeno chamado BIG DATA?

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba 3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Olá pessoal!

Alguns perguntaram como fazer para deletar as linhas que estão em branco na planilha, logo que a esta for aberta.

Segue um código, simples, honesto, rápido e limpinho.

Private Sub Worksheet_Change (ByVal Target As Range)
'Deleta todas as linhas que estiverem em branco que existirem.  
'Previne loops infinitos  Let Application.EnableEvents = False   
'Caso haja mais de uma célula selecionada. 
If Target.Cells.Count > 1 Then
GoTo SelectionCode  
If WorksheetFunction.CountA(Target.EntireRow) = 0 Then 
Target.EntireRow.Delete 
End If  
Let Application.EnableEvents = True  
Exit Sub
SelectionCode: 
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then 
Selection.EntireRow.Delete 
End If  
Let Application.EnableEvents = True
End Sub

Tags: VBA, Excel, deletar, apagar, excluir, row, lines, linha, range, rows, blank, removing, EntireRow, automatically, delete

VBA Excel - Excluir linhas em branco logo ao abrir a Planilha - Removing Blank Rows Automatically

| Blog Office VBA | Blog Excel | Blog Access |

+ de 100.000 VISITAS

Acesse: http://goo.gl/0v6AO   

Sim pessoal. sempre perguntam como deletar linhas em branco da planilha, assim que esta for aberta. Segue um código, simples, honesto, rápido e limpinho:

Private Sub Worksheet_Change (ByVal Target As Range)

'Deleta todas as linhas que estiverem em branco que existirem.  

'Previne loops infinitos  Let Application.EnableEvents = False   

'Caso haja mais de uma célula selecionada. 

If Target.Cells.Count > 1 Then

GoTo SelectionCode  

If WorksheetFunction.CountA(Target.EntireRow) = 0 Then 

Target.EntireRow.Delete 

End If  

Let Application.EnableEvents = True  

Exit Sub  

SelectionCode: 

If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then 

Selection.EntireRow.Delete 

End If  

Let Application.EnableEvents = True

End Sub

Tags: VBA, Excel, deletar, apagar, excluir, rows, blank, lines, linha, range, removing, EntireRow, automatically, delete

VBA Excel - Limpando cabeçalhos sem uso no Excel

Desenvolvi esta solução a partir de várias soluções que poderão consultar depois.

6º exemplo:

Sub RemovePageHeaders()

    Application.ScreenUpdating = False

    Dim objRange As Range

    Set objRange = Cells.Find("HeaderText")

    While objRange <> ""

        objRange.Offset(1, 0).Rows(1).EntireRow.Delete

        objRange.Rows(1).EntireRow.Delete

        Set objRange = Cells.Find("HeaderText")

    Wend

    MsgBox ("Removido todos os cabeçalhos")

End Sub

Tags: Excel, Delete, clean, remove, header, Linha, Plan, Planilhas, Row,  rows, worksheet, lines, UDF

André Luiz Bernardes

A&A® - In Any Place.

VBA Excel - Como deixar suas planilhas enxutas

Confesso que manter o tamanho das planilhas sejam um tema recorrente e difícil de divulgar. Certamente causa interesse, mas o ponto principal é: Como deixá-las menores?

Ja abordei este assunto diversas vezes, sobre óticas distintas: Explicando o motivo destas ficarem assim, mostrando ações efetivas de torná-las menores, demonstrei técnicas com o VBA e tudo o mais.

Nos idos de 2009, escrevi coisas similares as demonstradas abaixo:

Possivelmente já percebeu como suas planilhas inflam sem qualquer aparente explicação, como se tivesse comido vários quilos de açúcar. De uma hora prá outra o que tinha apenas uns parcos 530 KB de peso, passa a ter e exibir exuberantes 2.350 KB. O que aconteceu? Será que nossas planilhas atacam a geladeira durante a madrugada?

Com o passar do tempo, sem que necessariamente tenhamos acrescentado algum conteúdo relevante, nossas planilhas persistem em aumentar.

Linhas inofensivas

:

É muito comum que somente abramos o nosso arquivo, efetuando pequenas alterações em certas células, além de vez ou outra inserirmos algumas linhas em branco, apenas para posicionarmos algumas informações. O que talvez não percebamos é que estas inofensivas linhas em branco não somem, antes são salvas, ocupando espaço desnecessário. Lógico que isso é muito comum devido a grande manipulação de dados que efetuamos diariamente. Nunca paramos prá pensar em tamanho no nosso dia-a-dia. Somente quando não temos espaço, ou quando o administrador da rede diz-nos que nosso espaço no Public está lotado é que pensamos no motivo de tão poucas planilhas ocuparem tanto espaço.

Mandando suas planilhas para o SPA

:

O MS Excel não consegue distinguir as linhas que estão em branco (pelo menos não o fazia corretamente na versão de 2009) ou vazias e acaba por gravar todas as ocorrências em branco como conteúdo das nossas planilhas. Além disso, caso formatemos uma coluna inteira até a linha 1 milhão (mesmo que sem querer), ao fechar a planilhas teremos gravado aquela coluna em um milhão de linhas, apenas porque esquecemos da formatação ali.

O tamanho das planilhas é uma preocupação constante nas nossas aplicações. A não ser que realmente precisemos ter ocorrências extensas, deveríamos automatizar a deleção das linhas excedentes.

Como faremos isso?

Técnicas de exclusão de linhas podem ser colocadas ao fecharmos e/ou gravarmos nossas planilhas...Isso as fariam efetuar atividades 'aeróbicas' constantemente, queimando suas calorias extras...

Deletar linhas e efetuar as tais tarefas aeróbicas podem tornar o fechamento das planilhas muito lento dependendo do tamanho.

Confesso que nesta época era persistente, por isso não parei por aí:

Quando nossas planilhas recebem dados de outras bases (fontes), seja através de ODBC, Macros ou mesmo informações da Internet, não raro aparecem melhares de linhas em branco. Caso ache útil deletá-las poderá implementar a solução abaixo.

Function EliminateThousandBlankLines(StarLine as Long)

' Author: André Luiz Bernardes.

'    Date: 05.02.2009

    Let nRow = StartLine

    Do While ActiveSheet.Cells(nRow, 1) <> ""

        If ActiveSheet.Cells(nRow, 1).Value <> strUserName Then

            ActiveSheet.Rows(nRow).EntireRow.Delete

        Else

            Let nRow = nRow + 1

        End If

    Loop

End Function

Nesta missão de suma importância, onde a deleção de linhas e colunas desnecessárias mostram-se tão preementes, deixo-vos códigos utilíssimos:

Function LastRow (nColumn As String, InitLine As Single) As Single

    ' Author:                     Date:               Contact:

    ' André Bernardes             16/09/2008 14:20    bernardess@gmail.com

    ' Retorna o número de ocorrências.

    Dim nLine As Single

    Dim nStart As Single

    Dim nFinito As Single

    Dim Cabessalho As Single

    Dim nCeo As String

    Application.Volatile

    Let nStart = InitLine + 1

    Let nFinito = 65000

    Let Cabessalho = InitLine

    Do While nStart < nFinito

        Let nCeo = nColumn & Trim(Str(nStart))

        If Application.ActiveSheet.Range(nCeo).Value = "" Then

            Exit Do

        End If

        'Let Application.StatusBar.Value = " Linha: " & nStart

        Let nStart = nStart + 1

    Loop

    Let LastRow = (nStart - 1) '- Cabeçalho

    'Let Application.StatusBar.Value = "  "

End Function

Function FindLastColumn() As Single

    Let FindLastColumn = Range("IV10").End(xlToLeft).Column

    

    'ActiveSheet.UsedRange.Columns.Count

    'Dim LastCol As Integer

    

    'Let LastCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column

    'Let FindLastColumn = LastCol

End Function

Private Sub Worksheet_BeforeDoubleClick (ByVal Target As Range, Cancel As Boolean)

NomePlanilha = ActiveSheet.Name

NomePasta = ActiveWorkbook.Name

Endereco = ActiveWorkbook.Path

UsuarioExcel = Application.UserName

UsuarioEstacao = Environ("USERNAME")

UltimaLinhaNumero = ActiveCell.SpecialCells(xlCellTypeLastCell).Row

UltimaColunaNumero = ActiveCell.SpecialCells(xlCellTypeLastCell).Column

UltimaCelulaRange = ActiveCell.SpecialCells(xlCellTypeLastCell).Address & " ou " & ActiveCell.SpecialCells(xlCellTypeLastCell).Address(RowAbsolute:=False) & " ou " & ActiveCell.SpecialCells(xlCellTypeLastCell).Address(ReferenceStyle:=xlR1C1)

CelulaAtualLinhaNumero = ActiveCell.Row

CelulaAtualColunaNumero = ActiveCell.Column

CelulaAtualRange = ActiveCell.Address & " ou " & ActiveCell.Address(RowAbsolute:=False) & " ou " & ActiveCell.Address(ReferenceStyle:=xlR1C1)

CelulaAtualRelativo = ActiveCell.Address(ReferenceStyle:=xlR1C1, RowAbsolute:=False, ColumnAbsolute:=False, RelativeTo:=Worksheets(NomePlanilha).Cells(1, 1))

MsgBox "Planilha Atual" & vbCrLf & vbCrLf & _

       vbTab & "Nome" & vbTab & vbTab & ": " & NomePlanilha & vbCrLf & _

       vbTab & "Última Linha" & vbTab & ": " & UltimaLinhaNumero & vbCrLf & _

       vbTab & "Última Coluna" & vbTab & ": " & UltimaColunaNumero & vbCrLf & _

       vbTab & "Última Célula" & vbTab & ": " & UltimaCelulaRange & vbCrLf & vbCrLf & vbCrLf & _

       "Célula Atual" & vbCrLf & vbCrLf & _

       vbTab & "Número da Linha" & vbTab & ": " & CelulaAtualLinhaNumero & vbCrLf & _

       vbTab & "Número da Coluna" & vbTab & ": " & CelulaAtualColunaNumero & vbCrLf & _

       vbTab & "Range" & vbTab & vbTab & ": " & CelulaAtualRange & vbCrLf & _

       vbTab & "Relativo a A1" & vbTab & ": " & CelulaAtualRelativo & vbCrLf & vbCrLf & vbCrLf & _

       "Outras Informações" & vbCrLf & vbCrLf & _

       "Nome da Pasta de Trabalho" & vbTab & vbTab & ": " & NomePasta & vbCrLf & _

       "Caminho da Pasta de Trabalho" & vbTab & ": " & Endereco & vbCrLf & _

       "Usuario (Excel)" & vbTab & vbTab & vbTab & ": " & UsuarioExcel & vbCrLf & _

       "Usuario (Estação)" & vbTab & vbTab & vbTab & ": " & UsuarioEstacao, vbInformation, "Informações"

End Sub

Referência: Canguru

Tags: Excel, delete, rows, lines, excel size, cell, cell info, worksheet, small workbook

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA Blogs

  

bernardes@.com

VBA Excel - Deletando Colunas ou Linhas no Range - Delete Columns or Lines in the range

Caros,

Continuando na linha: "Revisitando As primeiras funções que desenvolvi".

DICA: Todas as funções que criarmos que tenham interação física direta nas planilhas que estivermos utilizando, terão uma performance muito melhor se colocarmos o comando Application.ScreenUpdating = False, antes do início do respectivo processamento.

Como deletar as linhas e colunas num range informado?

Sub DelEveryNthR (DeleteRange As Range, N As Integer)

    Dim rCount As Long, r As Long

    Application.ScreenUpdating = False

    If DeleteRange Is Nothing Then Exit Sub

    If DeleteRange.Areas.Count > 1 Then Exit Sub

    If N < 2 Then Exit Sub

    With DeleteRange

        Let rCount = .Rows.Count

        For r = N To rCount Step N - 1

            .Rows(r).EntireRow.Delete

        Next r

    End With

End Sub

Sub DeleteEveryNthC (DeleteRange As Range, N As Integer)

    Dim cCount As Long, c As Long

    Application.ScreenUpdating = False

    If DeleteRange Is Nothing Then Exit Sub

    If DeleteRange.Areas.Count > 1 Then Exit Sub

    If N < 2 Then Exit Sub

    With DeleteRange

        Let cCount = .Columns.Count

        For c = N To cCount Step N - 1

            .Columns(c).EntireColumn.Delete

        Next c

    End With

End Sub

Tags: Bernardes, MS, Microsoft, Office, Excel, deletar, apagar, excluir, row, lines, linha, range, rows, blank, removing, EntireRow, automatically, delete, column, coluna

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA Blogs

  

bernardes@.com