Como Deletar Linhas de uma Planilha ou Tabela de Celulas Selecionadas.

Question

Bom dia.

Fiz uma rotina para deletar linhas de celulas na planilha e Tabelas  em que as celulas apos selecionadas,  deletava as linhas dessas celulas selecionadas com codigos como abaixo.

Selection.EntireRow.Select

Selection.Delete

O codigo acima funciona bem quando seleciona uma celula ou celulas continuas, mas quando as celulas nao sao continuas, esta dando erro.

Sera que teria uma forma de deletar linhas de celulas selecionadas nao continuas em:

1. Planilhas---->As planilhas estao protegidas e o usuario tem acesso limitado, portanto o usuario seleciona as celulas que ele tem acesso e deseja eliminar, e com VBA desprotege ,deleta a linha inteira e volto a proteger.
2. Tabelas------>Nas planilhas que tem Tabelas, possuem outros dados ao lado dessas Tabelas e quando seleciono celulas que desejo que as linhas dessa Tabela seja eliminada, e nao delete outros dados fora da Tabela como no item1

Desde ja agradeco a quem possa ajudar

Tadao

Answer 1

Sobre usar métodos Select: http://ambienteoffice.com.br/blog/gravador-de-macros/#activecell,-select-e-activate

---

Sub Main()
    Dim iArea As Range
    Dim rSelection As Range
    
    Set rSelection = Selection
    
    For Each iArea In rSelection.Areas
        iArea.EntireRow.Delete
    Next iArea
End Sub

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 2

Ola Felipe, obrigado pelo retorno.

Rodei a rotina e funcionou beleza, esse For Each e muito possante,nao?, tem varias utilidades..obrigado pela solucao.

No segundo caso. tenho uma Tabela conforme fig 1  onde estao selecionados as celulas C5/7/9/10 da  planila ou seja ranges 2,4,6,e,7 da Tabela e gostaria de deletar so as ranges da Tabela e nao a linha inteira da planilha pois afetaria os dados nas colunas A e H.

Para deletar ranges da Tabela(ListObjects) uso o codigo abaixo:

ActiveSheet.ListObjects(1).ListRows(n).Delete, sendo n a linha da Tabela que deseja eliminar. Seria o caso de usar o For Each nessa variavel n?...........mas antes teria que tranformar as celulas selecionadas em numero da linha da Tabela?

Tadao

fig 1

Answer 3

A rotina é bem mais complexa:

Sub Main()
    Dim cRows As Collection
    Dim vRows As Variant
    Dim iCell As Variant
    Dim iLO As ListObject
    Dim loOriginal As ListObject
    Dim i As Long
    Dim iRow As Long
    
    Set cRows = New Collection
    
    On Error Resume Next
    Set loOriginal = Selection.Cells(1).ListObject
    If loOriginal Is Nothing Then GoTo Quit
    
    For Each iCell In Selection.Cells
        Set iLO = Nothing
        Set iLO = iCell.ListObject
        If iLO.Name <> loOriginal.Name Then GoTo Continue
        iRow = iCell.Row - loOriginal.HeaderRowRange.Row
        
        cRows.Add iRow, CStr(iRow)
Continue:
    Next iCell
    On Error GoTo 0
    
    ReDim vRows(1 To cRows.Count)
    For i = 1 To cRows.Count
        vRows(i) = cRows(i)
    Next i
    
    QuickSort vRows
    
    For i = UBound(vRows) To LBound(vRows) Step -1
        loOriginal.ListRows(vRows(i)).Delete
    Next i
    
Quit:
End Sub

Private Sub QuickSort(vSort As Variant, _
                      Optional vLow As Variant, _
                      Optional vHigh As Variant)
    'Ordena um vetor utilizando um algoritmo do tipo Quick Sort.
    
    Dim vPivot As Variant
    Dim vSwitch As Variant
    Dim lLow As Long
    Dim lHigh As Long
    
    If IsMissing(vLow) Then vLow = LBound(vSort)
    If IsMissing(vHigh) Then vHigh = UBound(vSort)
    
    lLow = vLow
    lHigh = vHigh
    vPivot = vSort((vLow + vHigh) \ 2)
    Do While lLow <= lHigh
        Do While vSort(lLow) < vPivot And lLow < vHigh
            lLow = lLow + 1
        Loop
        Do While vPivot < vSort(lHigh) And lHigh > vLow
            lHigh = lHigh - 1
        Loop
        If lLow <= lHigh Then
            vSwitch = vSort(lLow)
            vSort(lLow) = vSort(lHigh)
            vSort(lHigh) = vSwitch
            lLow = lLow + 1
            lHigh = lHigh - 1
        End If
    Loop
    
    If vLow < lHigh Then QuickSort vSort, vLow, lHigh
    If lLow < vHigh Then QuickSort vSort, lLow, vHigh
End Sub

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 4

Ohhh.....Felipe, funciona que e uma beleza. Realmente e muito complicado,nao?. Ate eu entender o que foi feito.........acho que nao vai dar tempo......vou colocar numa Sub ApgRegTab() e sempre que precisar chamo Call ApgRegTab e......Zip !Zun!,..... Limpa!. Muito obrigado.

Tadao

Answer 5

Bom dia Felipe, primeiro obrigado pela rotina para deletar as linhas da tabela selecionadas.

Estava testando na planiha onde vou usar, e deparei que se selecionar a segunda linha ou primeira ate o fim como mostra a fig 1, da erro. Depois de apertar o depurar sae a fig 2. O que deve ser?.

Uma outra coisa que se puder ajudar, e que fiz uma rotina de evento que ao dar dois clicks na ultima linha da coluna Funcionario, insere uma nova linha para registrar novo funcionario, como mostra o codigo da fig 3. Ela esta funcionado, mas quando deleta todas a linhas, a Tabela ainda fica com uma linha, e se der dois clicks nessa linha da coluna Funcionario, fica esquisito, como devo corrigir o codigo?

Desde ja agradeco se puder decifrar.

Tadao

Fig 1

Fig 2

Fig 3

'==================================================================================
'Evento qdo der dois clicks na ultima linha da Tablela insere uma linha
'==================================================================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
With ActiveSheet
If Not Intersect(myRange, Target) Is Nothing Then
    Application.EnableEvents = False
    .Unprotect
    .ListObjects(1).ListRows.Add
    With .ListObjects(1)
        .TotalsRowRange.Offset(-1).Select
        Intersect(Range("ShiHody[[Ctr]]"), .TotalsRowRange.Offset(-1)).Value = "Yes"
    End With
    ActiveCell.Offset(1).Select
    .Protect , DrawingObjects:=False
    Application.EnableEvents = True
Else
    .Unprotect
    .Protect , DrawingObjects:=False
    .EnableSelection = xlUnlockedCells
End If
Application.ScreenUpdating = True
End With
End Sub

'=============================================================================
'Funcao MyRange que define como sendo a ultima celula da primeira coluna da Tabela
'=============================================================================
Function myRange() As Range
With ListObjects(1)
    If .ListRows.Count > 0 Then
       Set myRange = .ListRows.Item(.ListRows.Count) _
           .Range.Cells(1, 1)
    Else
       Set myRange = .HeaderRowRange.Offset(1).Cells(1, 1)
    End If
End With

Answer 6

Antônio,

Comigo a rotina funciona normalmente.

Criei uma tabela, selecionei uma coluna inteira e rodei, apagaram todas as linhas.

Depois, selecionei da linha 2 até o fim, rodou normalmente também.

Não faço ideia do que pode ser.

---

http://www.ambienteoffice.com.br || Grupo de WhatsApp: https://chat.whatsapp.com/K1uey5Q4yJdKnsgWkVQAZG

Answer 7

Obrigado,Felipe. Vou tentar analizar melhor para ver a causa.

Tadao