9 Operações Práticas com Range

9.1 Mover Dados com Recortar, Copiar e Colar

origemRange.Cut [Destino]

Se um Destino for especificado, equivale a Ctrl+X no range de origem e Ctrl+V no destino. Se nenhum destino for fornecido, equivale apenas ao Ctrl+X no range de origem.

origemRange.Copy [Destino]

Se um Destino for especificado, equivale a Ctrl+C no range de origem e Ctrl+V no destino. Se nenhum destino for fornecido, equivale apenas ao Ctrl+C no range de origem.

Application.CutCopyMode = False remove a borda pontilhada animada que aparece ao redor das células durante uma operação de cópia ou recorte.

rangeDestino.PasteSpecial

Possui os seguintes argumentos:

  • paste: Define o tipo de conteúdo a ser colado. Opções comuns incluem xlPasteAll (padrão), xlPasteValues, xlPasteFormats, xlPasteFormulas e xlPasteColumnWidths.
  • operation: Define uma operação aritmética a ser aplicada aos valores existentes no destino. Por exemplo, xlPasteSpecialOperationAdd soma os valores copiados aos valores existantes.
  • SkipBlanks: Quando definido como True, impede que células em branco na área de origem substituam células no destino. O padrão é False.
  • Transpose: Quando definido como True, transpõe as linhas e colunas dos dados copiados antes de colá-los. O padrão é False.

rangeParaDeletar.Delete [Deslocamento]

O argumento Deslocamento (XlDeleteShiftDirection) determina como as células adjacentes devem se mover para preencher o espaço criado pela exclusão. As opções são xlShiftToLeft (desloca células à esquerda) ou xlShiftUp (desloca células para cima). Se omitido, o Excel decide com base na forma do range.

9.2 Encontrando Nosso Alvo

Os métodos Find, FindNext e FindPrevious permitem buscar valores dentro de um range. Para documentação completa dos parâmetros, consulte a referência do VBA no MSDN.

Exemplo de código: Usando Find e Copy para preencher uma lista de resultados

' Constantes para nomes de folha e ranges
Private Const FOLHA_PESQUISA As String = "ExemploFind"
Private Const RANGE_LISTA As String = "ListaEncontrados"
Private Const RANGE_ALVO As String = "PesquisarPor"

Sub ExemploFind()
    Dim folha As Worksheet
    Dim rngPesquisa As Range
    Dim rngEncontrado As Range
    Dim strPrimeiro As String
    Dim blnContinuar As Boolean
    
    LimparListaEncontrados
    Set folha = ThisWorkbook.Worksheets(FOLHA_PESQUISA)
    blnContinuar = True
    Set rngPesquisa = ObterRangePesquisa(folha)
    
    ' Realiza a primeira busca
    Set rngEncontrado = rngPesquisa.Find(What:=folha.Range(RANGE_ALVO).Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' Armazena o endereço do primeiro achado para controle do loop
    If Not rngEncontrado Is Nothing Then
        strPrimeiro = rngEncontrado.Address
    End If
    
    ' Loop para encontrar todas as ocorrências
    Do While Not rngEncontrado Is Nothing And blnContinuar
        TransferirItem rngEncontrado
        
        ' Continua a busca a partir da próxima célula
        Set rngEncontrado = rngPesquisa.FindNext(rngEncontrado)
        
        ' Encerra o loop se retornar ao ponto de partida
        If rngEncontrado.Address = strPrimeiro Then blnContinuar = False
    Loop
    
    ' Libera objetos
    Set rngPesquisa = Nothing
    Set rngEncontrado = Nothing
    Set folha = Nothing
End Sub

Function ObterRangePesquisa(folha As Worksheet) As Range
    Dim lngUltimaLinha As Long
    lngUltimaLinha = folha.Cells(folha.Rows.Count, 2).End(xlUp).Row
    Set ObterRangePesquisa = folha.Range(folha.Cells(1, 2), folha.Cells(lngUltimaLinha, 2))
End Function

Sub TransferirItem(rngItem As Range)
    Dim rngDestino As Range
    Dim rngLinhaCompleta As Range
    
    ' Cria uma referência para a linha inteira do item encontrado
    Set rngLinhaCompleta = rngItem.EntireRow
    
    ' Define a posição inicial da lista de resultados
    Set rngDestino = rngItem.Parent.Range(RANGE_LISTA)
    
    ' Localiza a primeira linha vazia na lista
    If IsEmpty(rngDestino.Offset(1, 0)) Then
        Set rngDestino = rngDestino.Offset(1, 0)
    Else
        Set rngDestino = rngDestino.End(xlDown).Offset(1, 0)
    End If
    
    ' Copia os dados da linha inteira para a lista de resultados
    rngLinhaCompleta.Copy Destination:=rngDestino
    
    Set rngDestino = Nothing
    Set rngLinhaCompleta = Nothing
End Sub

Sub LimparListaEncontrados()
    Dim folha As Worksheet
    Dim rngArea As Range
    
    Set folha = ThisWorkbook.Worksheets(FOLHA_PESQUISA)
    ' Assume que a lista começa logo abaixo do cabeçalho nomeado
    On Error Resume Next
    Set rngArea = folha.Range(RANGE_LISTA).Offset(1, 0).Resize(folha.Rows.Count - 1)
    If Not rngArea Is Nothing Then rngArea.ClearContents
    On Error GoTo 0
    
    Set rngArea = Nothing
    Set folha = Nothing
End Sub

9.3 Substituindo com Replace

O método Replace de um objeto Range permite localizar e substituir conteúdo. Para documentação completa, consulte a referência do VBA.

Exemplo de código: Preenchendo células em branco

Sub ExemploReplace()
    Dim folha As Worksheet
    Dim rng As Range
    Dim lngUltimaLinha As Long
    
    Set folha = ThisWorkbook.Worksheets("Dados")
    lngUltimaLinha = folha.Cells(folha.Rows.Count, 1).End(xlUp).Row
    
    ' Substitui células vazias na coluna B por "DESCONHECIDO"
    Set rng = folha.Range("B2:B" & lngUltimaLinha)
    rng.Replace What:="", Replacement:="DESCONHECIDO", LookAt:=xlWhole
    
    ' Substitui células vazias na coluna D por "0"
    Set rng = folha.Range("D2:D" & lngUltimaLinha)
    rng.Replace What:="", Replacement:="0", LookAt:=xlWhole
    
    Set rng = Nothing
    Set folha = Nothing
End Sub

Exemplo de código: Substituindo formatos

Sub SubstituirFormatos()
    ' Define o formato a ser procurado
    With Application.FindFormat.Font
        .Bold = True
        .Size = 11
    End With
    
    ' Define o novo formato a ser aplicado
    With Application.ReplaceFormat.Font
        .Bold = False
        .Italic = True
        .Size = 8
    End With
    
    ' Executa a substituição baseada apenas no formato
    ActiveSheet.Cells.Replace What:="", Replacement:="", _
        SearchFormat:=True, ReplaceFormat:=True
    
    ' Limpa os formatos de busca/substituição para não afetar outras operações
    Application.FindFormat.Clear
    Application.ReplaceFormat.Clear
End Sub

9.4 Seleção Especial: Filtros Poderosos

A propriedade SpecialCells retorna um range que atende a critérios específicos, como células com fórmulas, constantes, células visíveis, etc. É crucial usar tratamento de erro, pois a propriedade gera um erro se nenhuma célula for encontrada.

Exemplo de código: Tratamento de erro com SpecialCells

Sub EncontrarCelulasComErro()
    Dim folha As Worksheet
    Dim rngErros As Range
    
    Set folha = ThisWorkbook.Worksheets("Dados")
    On Error Resume Next ' Habilita o tratamento de erro
    Set rngErros = folha.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
    On Error GoTo 0 ' Restaura o tratamento de erros padrão
    
    If Not rngErros Is Nothing Then
        rngErros.Interior.Color = vbRed
        MsgBox rngErros.Cells.Count & " células com erros foram destacadas.", vbInformation
    Else
        MsgBox "Nenhuma célula com erro foi encontrada na folha '" & folha.Name & "'.", vbInformation
    End If
    
    Set rngErros = Nothing
    Set folha = Nothing
End Sub

9.5 CurrentRegion: Um Atalho Útil para Listas

A propriedade CurrentRegion de um objeto Range retorna o bloco contínuo de dados que o rodeia, delimitado por linhas e colunas em branco. É ideal para obter rapidamente um range associado a uma tabela ou lista. A propriedade ListHeaderRows do range resultante indica quantas linhas de cabeçalho existem no topo da região.

Exemplo de código: Analisando as características de uma lista

Sub AnalisarRegiaoAtual()
    Dim folha As Worksheet
    Dim rngLista As Range
    Dim rngDados As Range
    Dim lngLinhasCabecalho As Long
    
    Set folha = ThisWorkbook.Worksheets("Vendas")
    Set rngLista = folha.Range("A1").CurrentRegion
    lngLinhasCabecalho = rngLista.ListHeaderRows
    
    ' Informações básicas da região
    folha.Range("H2").Value = rngLista.Rows.Count ' Total de linhas (inclui cabeçalho)
    folha.Range("H3").Value = rngLista.Columns.Count ' Número de colunas
    
    ' Define o range apenas para os dados (excluindo cabeçalho)
    Set rngDados = rngLista.Offset(lngLinhasCabecalho, 0).Resize(rngLista.Rows.Count - lngLinhasCabecalho)
    
    ' Informações apenas dos dados
    folha.Range("H4").Value = rngDados.Rows.Count ' Linhas de dados
    folha.Range("H5").Value = rngDados.Cells.Count ' Total de células de dados
    folha.Range("H6").Value = Application.WorksheetFunction.CountBlank(rngDados) ' Células vazias
    folha.Range("H7").Value = Application.WorksheetFunction.Count(rngDados) ' Células numéricas
    folha.Range("H8").Value = rngDados(rngDados.Rows.Count, 1).Row ' Número da última linha
    
    Set rngDados = Nothing
    Set rngLista = Nothing
    Set folha = Nothing
End Sub

9.6 Ordenando Listas de Forma Interativa

O método Sort de um objeto Range permite ordenar os dados. Para ordenação com suporte a caracteres especiais (ex: chinês), utilize o método SortSpecial.

Exemplo de código: Ordenação por clique duplo no cabeçalho

Este código deve ser inserido no módulo de código da folha que contém a lista.

Private mlngColunaAtual As Long
Private mOrdem As XlSortOrder

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Verifica se o clique foi em uma célula de cabeçalho (primeira linha)
    If Target.Row = 1 Then
        Cancel = True ' Impede a edição da célula
        
        ' Verifica se é uma coluna diferente da última clicada
        If Target.Column <> mlngColunaAtual Then
            mlngColunaAtual = Target.Column
            mOrdem = xlAscending ' Padrão: ascendente
        Else
            ' Alterna a direção da ordenação
            If mOrdem = xlAscending Then
                mOrdem = xlDescending
            Else
                mOrdem = xlAscending
            End If
        End If
        
        ' Chama a rotina de ordenação
        OrdenarLista
    End If
End Sub

Private Sub OrdenarLista()
    Dim rngDados As Range
    Dim lngCabecalho As Long
    
    ' Obtém a região atual a partir da célula A1
    Set rngDados = Range("A1").CurrentRegion
    lngCabecalho = rngDados.ListHeaderRows
    
    ' Aplica a ordenação
    With rngDados
        .Sort Key1:=.Cells(1, mlngColunaAtual), _
              Order1:=mOrdem, _
              Header:=IIf(lngCabecalho > 0, xlYes, xlNo), _
              Orientation:=xlTopToBottom
    End With
    
    Set rngDados = Nothing
End Sub

Tags: VBA Excel Range Macro Automação

Publicado em 7-16 09:20