| Descricao: |
Esse macro do Aplicativo Microsoft Excel VBA, procura por determinada palavra em determinada coluna e a deleta, esses critérios são coletados a partir uma entrada de dados Inpubtox. Espero que o exemplo possam lhes ser útil, Fique com Deus,
Expedito Marcondes.
Sub sbx_deletar_linhas_baseado_criterios()
Dim vRange As Range, DeletaRange As Range, vColuna As Range
Dim vProcuraTexto As String, vProcuraColuna As String, vColunaAtiva As String
Dim PrimeiroEndereco As String, CheckaNulo As String
Dim SCA
[C1].Select ' Para selecionar a coluna(C),
'Extract active column as text
SCA = Split(ActiveCell.EntireColumn.Address(, False), ":")
vColunaAtiva = SCA(0)
vProcuraColuna = InputBox("Digite a coluna desejada ou cancela para sair", "Linha código para deletar", vColunaAtiva)
On Error Resume Next
Set vRange = Columns(vProcuraColuna)
On Error GoTo 0
'Se um intervalo inválido for inserido em seguida, sair
If vRange Is Nothing Then Exit Sub
vProcuraTexto = InputBox("Entre com o texto procurado", "Deleta código linha", [E1].Value) 'ActiveCell.Value)
If vProcuraTexto = "" Then
CheckaNulo = InputBox("Você realmente deseja excluir linhas com células vazias?" & vbNewLine & vbNewLine & _
"Sim quero, caso contrário sairá código", "Cuidado", "Não")
If CheckaNulo <> "Sim" Then Exit Sub
End If
Application.ScreenUpdating = False
'para coincidir com a seqüência de texto TODO
Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'para corresponder a uma cadeia de texto PARCIAL use esta linha
'Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
'para coincidir com o caso e de uma cadeia de texto TODO
'Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
If Not vColuna Is Nothing Then
Set DeletaRange = vColuna
PrimeiroEndereco = vColuna.Address
Do
Set vColuna = vRange.FindNext(vColuna)
Set DeletaRange = Union(DeletaRange, vColuna)
Loop While PrimeiroEndereco <> vColuna.Address
'nao deixe de ver nosso trabalho com 100 planilhas exemplos Loops (com todas as intruções Do/While/Loop/until/For Next/)
End If
'Se houver condição verdadeira exclua as linhas
sbx = MsgBox("As Linhas contendo a palavra [ " & [E1] & " ] serão deletadas!!!", vbYesNo + vbCritical, "CUIDADO - AÇÃO IRREVERSÍVEL!!")
If sbx = 6 Then
If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete
End If
'caso queira retirar a mensagem vbyesno.
' If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Sub limpar_teste()
[a].Copy [b]
[b].Value = "LISTA"
MsgBox "dados copiados para teste com sucesso!!!", vbInformation, "Saberexcel - site das macros"
End Sub
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.
|