3

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
7
  • Quais foram as suas tentativas para solucionar o seu problema? Commented 5/10/2015 às 22:23
  • Olá @RodrigoGomes, consegui solucionar assim: 1. fiz uma função para retirar o texto (que graças a Deus segue um padrão); 2. outra função para remover campos em branco. E como o Excel tem uma função integrada para excluir células em branco, ficou super rápido, ainda que com 16 mil linhas! =) Posto o código como resposta, para referência futura?
    – Evert
    Commented 6/10/2015 às 1:40
  • Poste sim! Se resolveu, perfeito.
    – RSinohara
    Commented 6/10/2015 às 12:42
  • @Evert, extrair os dados significa deletá-los da planilha e deixar somente aqueles que são números?
    – cantoni
    Commented 28/10/2015 às 12:08
  • Olá @cantoni, neste caso extrair seria retirar os dados que são de interesse. Excluindo os demais. Na resposta abaixo está desta forma, excluindo os dados indesejados.
    – Evert
    Commented 28/10/2015 às 13:30

3 Respostas 3

2

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.

1

Solução encontrada:

  1. 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
    
  2. 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
    
  3. 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
    
  4. 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!

3
  • Por alguma razão não conseguir formar corretamente o código, com indentação etc... Se alguém conseguir melhorar a formatação, ficarei grato. Abs
    – Evert
    Commented 7/10/2015 às 15:18
  • Quando tá dentro de uma lista numerada tem que dar 8 espaços antes do código, não sei bem o por quê, mas sei que é assim. Consertado ;-)
    – Math
    Commented 7/10/2015 às 15:47
  • @Math valeu!!!!
    – Evert
    Commented 8/10/2015 às 16:28
1

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
1
  • Não testei seu modelo, mas acho que funcionaria também, no caso do Colar Especial, não poderia usar a opção 'True' no SkipBlanks?
    – Evert
    Commented 8/10/2015 às 16:29

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .