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

VBA Excel - Proteja-se para que ninguém copie e cole conteúdo nas suas planilhas - To prevent people cutting/copying and pasting when your workbook is open

| Blog Office VBA | Blog Excel | Blog Access |


Geralmente, se não todas as vezes, desejamos que os nossos Relatórios, Dashboards e Aplicações não sejam copiadas, ou tenham os seus conteúdos e layouts alterados por alguém que inadvertidamente cole dados na nossa planilha. 

Há como protegê-las dessas intempéries? Sim! Divirta-se com os códigos abaixo:

Sub DisableCutAndPaste()

  EnableControl 21, False   ' cut

  EnableControl 19, False   ' copy

  EnableControl 22, False   ' paste

  EnableControl 755, False  ' pastespecial

  Application.OnKey "^c", ""

  Application.OnKey "^v", ""

  Application.OnKey "+{DEL}", ""

  Application.OnKey "+{INSERT}", ""

  Application.CellDragAndDrop = False

End Sub

Sub EnableCutAndPaste()

  EnableControl 21, True   ' cut

  EnableControl 19, True   ' copy

  EnableControl 22, True   ' paste

  EnableControl 755, True  ' pastespecial

  Application.OnKey "^c"

  Application.OnKey "^v"

  Application.OnKey "+{DEL}"

  Application.OnKey "+{INSERT}"

  Application.CellDragAndDrop = True

End Sub

Sub EnableControl (Id As Integer, Enabled As Boolean)

  Dim CB As CommandBar

  Dim C As CommandBarControl

  For Each CB In Application.CommandBars

    Set C = CB.FindControl(Id:=Id, recursive:=True)

    If Not C Is Nothing Then C.Enabled = Enabled

  Next

End Sub

Reference:

Bill Manville


Tags: VBA, Excel, cutting, copying, pasting, cut, copy, past
  

MS Excel - Deletando linhas - 07 – Linhas duplicadas - Delete duplicate rows

Termo de Responsabilidade

Olá novamente... Vez por outra colamos bases de dados no MS Excel para análise e sem que nos apercebamos dados duplicados acabam ficando juntos em nosso range.

Como efetuar uma depuração que retire as ocorrências duplicadas deixando somente uma versão de cada registro?

Pois bem, a solução abaixo é o resultado de tal necessidade. Implementem, deixem o crédito para quem desenvolveu e tudo estará bem.

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 Long

Dim n As Long

Dim v As Variant

On Error GoTo EndMacro

Let Application.ScreenUpdating = False

Let Application.Calculation = xlCalculationManual

Let Application.StatusBar = "Linha sendo processada: " & _ 
Format(rng.Row, "#,##0")

Let n = 0

For r = rng.Rows.Count To 2 Step -1

If r Mod 500 = 0 Then

Let Application.StatusBar = "Processing Row: " & Format(r, "#,##0")

End If

Let v = rng.Cells(r, 1).Value

If v = vbNullString Then

If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then

rng.Rows(r).EntireRow.Delete

Let n = n + 1

End If

Else

If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then

rng.Rows(r).EntireRow.Delete

Let n = n + 1

End If

End If

Next r

EndMacro:

Let Application.StatusBar = False

Let Application.ScreenUpdating = True

Let Application.Calculation = xlCalculationAutomatic

MsgBox CStr(n) & "Linha(s) Duplicada(s) Deleta(s) "

End Sub

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

André Luiz Bernardes

A&A® - In Any Place.