Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

Views

VBA - Deletando linhas duplicadas

Vez por outra colamos bases de dados no MS Excel para análise e manipulação. Nem sempre tais dados foram previamente depurados, possibilitando que linhas duplicadas estejam no range que manipulamos sem que nos apercebamos disso.

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

A solução abaixo ajuda nesta necessidade. Implementem e mantenham o autor, ok?


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 a SUB encontrar a mesma ocorrência no Range,
            '  deletará as seguintes.

            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


Vejam outras várias sugestões...
Blog Excel
Blog Access
Blog Office




LinkWithinBrazilVBAAccessSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine