Manipulando as linhas e colunas
Conditionally Deleting Rows
Delete Cells/Rows in Range, based on empty cells
Delete Empty Rows
Delete Excel Rows Based on a Specified Condition or Criteria
Delete Row if a specific value exist
Delete Row if cell contains
Delete Row in a range
Delete Rows In Excel
Delete Rows and columns using VBA in Microsoft Excel
Delete entire ROW if a cell contains a phrase
Deleting Empty Rows
Deleting Rows
Excel Automatically Delete Rows that contain a certain word
Excel VBA Blank row deletion in Excel using methods other than loops
Excel blank row deletion?
How To Delete Rows
Macro for deleting Row with condition
Macro to delete Rows in excel?
Macro to remove blank cells
Remove Blank Rows
VBA Delete Entire Row if Contains Certain Text
VBA Delete Excel Rows Based on Certain Date
Entre todas as técnicas de VBA, esta é uma das melhores. já tive a oportunidade de disponibilizar aqui outros modos de como identificar qual é a última linha (ou o último registro) numa planilha de dados. Para ser breve e suscinto, as outras técnicas volta e meia eram falhas devido a "dirty area". Depois de algum tempo alguns programadores acharam a melhor técnica para identificarmos a última ocorrência sem falhas. O exemplo abaixo é uma variante da técnica ensinada pelo Excel MVP, Bob Umlas. Testem naquelas bases de dados mais "parrudas", com grandes quantidades de dados, acima de 100.000 linhas e vejam o excelente resultado.
- CÓDIGO:
-
Function LCell(ws As Worksheet) As Range Dim LRow&, LCol% On Error Resume Next With ws Let LRow& = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Let LCol% = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column End With Set LCell = ws.Cells(LRow&, LCol%) End Function
- CÓDIGO:
-
Sub Identifica() MsgBox LCell(Sheet1).Row End Sub
Outra contribuição interessante é essa cuja a função retorna diretamente o número da última linha, inclusive para uma célula de planilha, contribuição do Adilson Soledade no Fórum da Info, num tópico que iniciei por lá:
- CÓDIGO:
-
Function LRow(Ref As Range) As Integer Dim ws As Worksheet On Error Resume Next Set ws = Ref.Parent LRow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row End Function
Muitas e muitas vezes, vejo postado neste e em outros diversos fóruns ao redor do mundo e na WEB 2.0, pessoas pedindo uma macro para excluir todas as linhas em branco ou todas as linhas duplicadas de uma série de linhas em uma planilha. Aqui tem três códigos: Bernardes_DeleteBlankRows, Bernardes_DeleteRowOnCell, e Bernardes_DeleteDuplicateRows, que fazem isso.
Lembre-se, estas macros apagam linhas inteiras de sua planilha, não excluem células individuais. Excluindo linhas em branco O código Bernardes_DeleteBlankRows descrito a seguir irá apagar todas as linhas em branco na planilha especificada pela WorksheetName parâmetro. Se este parâmetro for omitido, a planilha ativa será utilizada. O procedimento apagará as linhas que estiverem totalmente em branco ou contiverem células cujo o conteúdo seja apenas um único apóstrofe (caracter que controla a formatação). O procedimento exige a função IsRowClear, mostrada após o procedimento Bernardes_DeleteBlankRows. Não apagará as linhas que contém fórmulas, mesmo que a fórmula retorne um valor vazio. A função não excluirá as linhas precedentes de uma fórmula em uma célula se as linhas precedentes tiverem menor número de linhas que a linha. No entanto, se uma fórmula referir-se a uma série de linhas com números mais altos do que as células que contém a fórmula, e as linhas forem totalmente em branco, as linhas referenciadas pela fórmula serão excluídas. Portanto, a referência da fórmula pode ser alterada nas linhas acima da fórmula excluída.
- CÓDIGO:
-
Sub Bernardes_DeleteBlankRows(Optional WorksheetName As Variant) ' This function will delete all blank rows on the worksheet ' named by WorksheetName. This will delete rows that are ' completely blank (every cell = vbNullString) or that have ' cells that contain only an apostrophe (special Text control ' character). ' The code will look at each cell that contains a formula, ' then look at the precedents of that formula, and will not ' delete rows that are a precedent to a formula. This will ' prevent deleting precedents of a formula where those ' precedents are in lower numbered rows than the formula ' (e.g., formula in A10 references A1:A5). If a formula ' references cell that are below (higher row number) the ' last used row (e.g, formula in A10 reference A20:A30 and ' last used row is A15), the refences in the formula will ' be changed due to the deletion of rows above the formula. ' Dim RefColl As Collection Dim RowNum As Long Dim Prec As Range Dim Rng As Range Dim DeleteRange As Range Dim LastRow As Long Dim FormulaCells As Range Dim Test As Long Dim WS As Worksheet Dim PrecCell As Range If IsMissing(WorksheetName) = True Then Set WS = ActiveSheet Else On Error Resume Next Set WS = ActiveWorkbook.Worksheets(WorksheetName) If Err.Number <> 0 Then ''''''''''''''''''''''''''''''' ' Invalid worksheet name. ''''''''''''''''''''''''''''''' Exit Sub End If End If If Application.WorksheetFunction.CountA(WS.UsedRange.Cells) = 0 Then '''''''''''''''''''''''''''''' ' Worksheet is blank. Get Out. '''''''''''''''''''''''''''''' Exit Sub End If '''''''''''''''''''''''''''''''''''''' ' Find the last used cell on the ' worksheet. '''''''''''''''''''''''''''''''''''''' Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _ searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) LastRow = Rng.Row Set RefColl = New Collection ''''''''''''''''''''''''''''''''''''' ' We go from bottom to top to keep ' the references intact, preventing ' #REF errors. ''''''''''''''''''''''''''''''''''''' For RowNum = LastRow To 1 Step -1 Set FormulaCells = Nothing If Application.WorksheetFunction.CountA(WS.Rows(RowNum)) = 0 Then '''''''''''''''''''''''''''''''''''' ' There are no non-blank cells in ' row R. See if R is in the RefColl ' reference Collection. If not, ' add row R to the DeleteRange. '''''''''''''''''''''''''''''''''''' On Error Resume Next Test = RefColl(CStr(RowNum)) If Err.Number <> 0 Then '''''''''''''''''''''''''' ' R is not in the RefColl ' collection. Add it to ' the DeleteRange variable. '''''''''''''''''''''''''' If DeleteRange Is Nothing Then Set DeleteRange = WS.Rows(RowNum) Else Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum)) End If Else '''''''''''''''''''''''''' ' R is in the collection. ' Do nothing. '''''''''''''''''''''''''' End If On Error GoTo 0 Err.Clear Else ''''''''''''''''''''''''''''''''''''' ' CountA > 0. Find the cells ' containing formula, and for ' each cell with a formula, find ' its precedents. Add the row number ' of each precedent to the RefColl ' collection. ''''''''''''''''''''''''''''''''''''' If IsRowClear(RowNum:=RowNum) = True Then ''''''''''''''''''''''''''''''''' ' Row contains nothing but blank ' cells or cells with only an ' apostrophe. Cells that contain ' only an apostrophe are counted ' by CountA, so we use IsRowClear ' to test for only apostrophes. ' Test if this row is in the ' RefColl collection. If it is ' not in the collection, add it ' to the DeleteRange. ''''''''''''''''''''''''''''''''' On Error Resume Next Test = RefColl(CStr(RowNum)) If Err.Number = 0 Then '''''''''''''''''''''''''''''''''''''' ' Row exists in RefColl. That means ' a formula is referencing this row. ' Do not delete the row. '''''''''''''''''''''''''''''''''''''' Else If DeleteRange Is Nothing Then Set DeleteRange = WS.Rows(RowNum) Else Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum)) End If End If Else On Error Resume Next Set FormulaCells = Nothing Set FormulaCells = WS.Rows(RowNum).SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If FormulaCells Is Nothing Then ''''''''''''''''''''''''' ' No formulas found. Do ' nothing. ''''''''''''''''''''''''' Else ''''''''''''''''''''''''''''''''''''''''''''''''''' ' Formulas found. Loop through the formula ' cells, and for each cell, find its precedents ' and add the row number of each precedent cell ' to the RefColl collection. ''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next For Each Rng In FormulaCells.Cells For Each Prec In Rng.Precedents.Cells RefColl.Add Item:=Prec.Row, key:=CStr(Prec.Row) Next Prec Next Rng On Error GoTo 0 End If End If End If ''''''''''''''''''''''''' ' Go to the next row, ' moving upwards. ''''''''''''''''''''''''' Next RowNum '''''''''''''''''''''''''''''''''''''''''' ' If we have rows to delete, delete them. '''''''''''''''''''''''''''''''''''''''''' If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete shift:=xlShiftUp End If End Sub Function IsRowClear(RowNum As Long) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''' ' IsRowClear ' This procedure returns True if all the cells ' in the row specified by RowNum as empty or ' contains only a "'" character. It returns False ' if the row contains only data or formulas. '''''''''''''''''''''''''''''''''''''''''''''''''' Dim ColNdx As Long Dim Rng As Range ColNdx = 1 Set Rng = Cells(RowNum, ColNdx) Do Until ColNdx = Columns.Count If (Rng.HasFormula = True) Or (Rng.Value <> vbNullString) Then IsRowClear = False Exit Function End If Set Rng = Cells(RowNum, ColNdx).End(xlToRight) ColNdx = Rng.Column Loop IsRowClear = True End Function
Fonte:
CPearson.com
Tags: André Luiz Bernardes, Analista, Programador VBA, MOS, Microsoft Office Specialist, VBA, Visual Basic for Applications, MS, Microsoft, Office, MS Office, 
MS Access, 
MS Excel, 
MS Outlook, 
MS Powerpoint, 
MS Word, MS Visio, MS Communicator, 
MS OneNote, 
MS Publisher, 
InfoPath, 
SharePoint Workspace, 
Lync,
MS Access, MS Excel, MS Outlook, MS Powerpoint, MS Word, MS Visio, MS Communicator, MS OneNote, MS Publisher, InfoPath, SharePoint Workspace, Lync, Bob Umlas
.com