Usando o Excel, preciso extrair, a partir de uma seleção, os dados numéricos. Exemplo:
Coluna 1
123
456
Bom
Ruim
789
Ótimo
A partir dos dados acima, preciso extrair os seguintes dados:
Coluna 2
123
456
789
Usando o Excel, preciso extrair, a partir de uma seleção, os dados numéricos. Exemplo:
Coluna 1
123
456
Bom
Ruim
789
Ótimo
A partir dos dados acima, preciso extrair os seguintes dados:
Coluna 2
123
456
789
Uma solução em VBA seria utilizar o procedimento abaixo. Note que ele é genérico, não serve apenas para o que está selecionado. Você passa um objeto do tipo Range e ele realiza a iteração por todas as células que compõe esse range.
Sub excluiLinhasNaoNumericasOuVazias(range As range)
Dim celulasParaDeletar As Scripting.Dictionary
Dim r As range
Set celulasParaDeletar = New Scripting.Dictionary
For Each r In range
If Not IsNumeric(r.Value) Or r.Value = "" Then
celulasParaDeletar.Add CStr(r.Row), r
End If
Next
For i = 0 To celulasParaDeletar.Count - 1
celulasParaDeletar.Items(i).Delete
Next
End Sub
Esta solução utiliza um objeto do tipo dicionário para armazenar as linhas que precisam ser excluídas. Não se pode excluir dentro loop que itera sobre as células, pois ao deletar uma linha, muda-se o range original passado como parâmetro. Consequentemente, algumas linhas que precisam ser deletadas não são.
Para utilizar a classe Scripting.Dictionary deve-se incluir uma referência chamada Microsoft Scripting Runtime.
A função isNumeric() é utilizada para determinar se o contéudo de uma célula é um número ou não. Células vazias são consideradas números pelo Excel, por causa disso, é necessário testar se o conteúdo é vazio.
Abaixo um teste para esta solução:
Sub teste()
excluiLinhasNaoNumericasOuVazias Selection
End Sub
Assume-se que células precisam estar selecionadas na planilha, já que um objeto do tipo Selection está sendo passado como parâmetro.
Solução encontrada:
Criei uma função para deletar uma string em uma função:
Function deleteString(ByVal STRING_TO_BE_DELETED As String)
'
' Deleta um texto específico
' IMPORTANTE: A origem já deve estar selecionado
'
Selection.Replace What:=STRING_TO_BE_DELETED, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Function
Outra função para deletar células em branco:
Function deleteBlank(Optional NOT_IN_USE As Boolean)
'
' Deleta espaços em brancos
' IMPORTANTE: Os dados já devem vir selecionados
'
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.delete
End Function
Uma função que chama essas duas, única que será chamada pela macro:
Function deleteString_Blank(ByVal RANGE_SELECTION As Range, ByVal LIST_TO_BE_DELETED As String)
'
' Deleta texto de uma seleção
'
Dim arr As Variant
Dim i As Integer
RANGE_SELECTION.Select
arr = Range(LIST_TO_BE_DELETED)
For i = LBound(arr, 1) To UBound(arr, 1)
deleteString arr(i, 1)
Next i
deleteBlank
End Function
E por o código que chama as funções e envia as variáveis:
deleteString_Blank Columns(1), "NOME_DA_LISTA"
Lembrando que o número '1' em Columns(1)
é a coluna selecionada e o "NOME_DA_LISTA" deve ser o intervalo nomeado contendo os dados que deverão ser deletados do intervalos de dados. No meu caso a lista é uma tabela com as seguintes opções, seguindo o exemplo acima (da pergunta):
Bom
Ruim
Ótimo
Espero ter ajudado!
Você também pode tentar utilizar uma outra formula, não sei o porque, sempre que uso SpecialCells(xlCellTypeBlanks)
,dá erro - Então escolhi tentar por autofilter
:
Sub seleciona_numeros()
Dim ultimalinha As Integer
'identifica ultima linha
ultimalinha = Range("A" & Rows.Count).End(xlUp).Row
'escreve COL2 na coluna B e verifica o que é numero na coluna A
Range("B1").FormulaR1C1 = "COL2"
Range("B2").FormulaR1C1 = "=IF(ISNUMBER(RC[-1]),RC[-1],"""")"
'aplica a formula até a ultima linha
Range("B2").Copy
Range("B2:B" & ultimalinha).PasteSpecial xlPasteAll
Application.CutCopyMode = False
'exclui as formulas colando como valores
Range("B2:B" & ultimalinha).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'filtra e exclui as linhas vazias
Range("B:B").Select
ActiveSheet.Range("$A$1:$B$" & ultimalinha).AutoFilter Field:=2, Criteria1:="="
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True
ActiveSheet.ShowAllData
End Sub