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

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

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



André Luiz Bernardes
A&A® - In Any Place.


MS Excel – Máscara para CNPJ















Como sabem, sempre precisamos nos lembrar dos campos tão tipicamente brasileiros para o preenchimento de cadastros.

O CNPJ não foge a regra, sempre necessitamos preparar o campo que receberá o seu conteúdo.



Abaixo uma pequena SUB que força o preenchimento de acordo com a máscara desejada.

Function CNPJFormat() as String
Let CNPJFormat = Format([Campo], "00"".""000"".""000""/""0000""-""00"
End Sub

Futuramente disponibilizo o modo de check quanto aos cálculos do mesmo, isso sim, muito mais interessantes.



Tags: VBA, Excel, CNPJ, format, máscara,





MS Excel – Deletando linhas - 05


Termo de Responsabilidade












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

A solução abaixo checa as linhas abaixo da linha 11 (o que poderá customizar), deletando quando encontra a linha totalmente em branco, bem como quando a coluna "C" estiver vazia.

Sub PreparePlan_DelAllBlankRows()
' Author: Date: Contact:
' André Bernardes 23/01/2009 10:17 bernardess@gmail.com
Dim i As Long ' We use Long in case they have over 32.767 rows selected.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = 11 To ActiveSheet.UsedRange.Rows.Count
If Range("C" & i).Value = "" Then 'WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Outro exemplo:


Sub DeleteBlankRows1()
'Deletes the entire row within the selection if the ENTIRE row contains no data.
'We use Long in case they have over 32,767 rows selected.
Dim i As Long
'We turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'We work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


Mais um exemplo:




Sub DeleteBlankRows2()
'Deletes the entire row within the selection if some of the cells WITHIN THE SELECTION contain no data.
On Error Resume Next
Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
End Sub


Terceiro exemplo:




Sub DeleteBlankRows3()
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim Rw As Range
If WorksheetFunction.CountA(Selection) = 0 Then
MsgBox "No data found", vbOKOnly, "OzGrid.com"
Exit Sub
End If
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each Rw In Selection.Rows
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then
Selection.EntireRow.Delete
End If
Next Rw
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


Quarto exemplo:




Sub MoveBlankRowsToBottom()
'Assumes the list has a heading
With Selection
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End Sub
Sub DeleteRowsBasedOnCriteria()
'Assumes the list has a heading.
With ActiveSheet
If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
.Range("A1").AutoFilter Field:=1, Criteria1:="Delete"
.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False
End With
End Sub


5º exemplo:




Sub DeleteRowsWithSpecifiedData()
'Looks in Column D and requires Column IV to be clean
Columns(4).EntireColumn.Insert
With Range("D1:D" & ActiveSheet.UsedRange.Rows.Count)
.FormulaR1C1 = "=IF(RC[1]="""","""",IF(RC[1]=""Not Needed"",NA()))"
.Value = .Value
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With
On Error GoTo 0
Columns(4).EntireColumn.Delete
End Sub



TagsExcel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines



André Luiz Bernardes
A&A® - In Any Place.


Related Posts Plugin for WordPress, Blogger...

Vitrine

diHITT - Notícias