Select Menu



por Alessandro Trovato

» » » » » » » VBA - Artigo 024 - Trabalhando com conjuntos de células
«
Proxima
Postagem mais recente
»
Anterior
Postagem mais antiga

Progredindo em VBA no Microsoft Excel

Trabalhando com conjuntos de células

O Excel possui duas funções para trabalhar com conjuntos de células: Union e Intersect. Os nomes são autoexplicativos: o primeiro une dois intervalos e o segundo retorna apenas as células que sejam comuns a ambos (a intersecção). Ambas exigem no mínimo dois argumentos e suportam até trinta argumentos. O uso é muito simples:

Union(Intervalo1, Intervalo2)
Intersect(Intervalo1, Intervalo2)

No caso do Intersect é preciso ficar atento para o caso dessa intersecção não retornar nenhuma célula, pois o Excel gera erro quando tenta trabalhar com um intervalo de células vazio. Isto significa que estas funções também não aceitam intervalos vazios como argumento.

Interseccao = Intersect(Intervalo1, Intervalo2)

If Interseccao Is Nothing Then
    Debug.Print "A intersecção não retornou nenhuma célula"
End If

Uma questão bem comum é quando realmente usar essas funções, pois muitos não veem muita utilidade. Eu uso para ajudar na formatação de células, evitando ter de formatar cada intervalo individualmente.

Suponha um relatório gerado com um número indefinido de linhas e preciso formatar algumas das colunas. Analise o código abaixo:

Sub FormatarTabela()

    Dim Tabela As Range
    Set Tabela = Range("A1").CurrentRegion
   
    Union(Intersect(Tabela, Columns(1)), _
        Intersect(Tabela, Columns(3))).HorizontalAlignment = xlCenter
   
End Sub

Primeiro foi criado uma variável Tabela, que recebe a toda a região a qual a célula A1 pertence. Não importa se o relatório gerar cinco ou mil linhas e se há três ou dez colunas, Tabela terá toda a área do relatório, graças ao método CurrentRegion.

Em seguida, há uma união de duas intersecções. A primeira intersecção retorna somente as células da primeira coluna pertencentes à Tabela, enquanto a segunda intersecção retorna a terceira coluna do intervalo. Com o Union tenho ambas intersecções unidas e posso usar o HorizontalAlignment uma única vez. Nenhuma célula abaixo da última linha será formatada.

Neste exemplo só há uma formatação, mas num caso real pode-se fazer diversas formatações em poucas linhas: números com quantidade fixa de dígitos, moeda, cores, alinhamentos etc. Com isso podemos formatar a tabela com poucas linhas, unindo intervalos que irão receber as mesmas formatações.

Mas há um porém: tabelas normalmente têm uma linha (ou mais) de cabeçalho. Da forma que está sendo feito, o cabeçalho está sendo formatado junto com os dados. Infelizmente o Excel não traz uma função para remover um intervalo de outro, só podemos fazer união ou intersecção. E felizmente podemos criar uma função para isso!

Vamos ver um pouco de teoria de conjuntos. Há dois tipos de diferenças:

- Diferença de conjuntos: É o resultado de todos os membros do conjunto A que não sejam membros em B. Em uma análise mais aprofundada, é o conjunto A menos a intersecção de A com B;

- Diferença simétrica: É o resultado de todos membros que estejam em A ou B, mas não em ambos. É a união dos conjuntos A e B menos a intersecção de A e B.

Tendo isso em mente, o que precisamos para retirar um cabeçalho do conjunto a ser formatado é a diferença de conjuntos, pois vamos considerar a primeira linha inteira para remover.

Com isso em mente, analise o código abaixo:

Function DiferençaDeIntervalos(Intervalo1 As Range, Intervalo2 As Range) As Range

    If Intervalo1 Is Nothing Then
        Err.Raise Number:=601, Description:="O argumento Intervalo1 está vazio"
    ElseIf Intervalo2 Is Nothing Then
        Err.Raise Number:=602, Description:="O argumento Intervalo2 está vazio"
    End If

    Dim Celula As Range
    Dim Interseccao As Range

    Set Interseccao = Intersect(Intervalo1, Intervalo2)

    For Each Celula In Intervalo1
        If Intersect(Celula, Interseccao) Is Nothing Then
            If DiferençaDeIntervalos Is Nothing Then
                Set DiferençaDeIntervalos = Celula
            Else
                Set DiferençaDeIntervalos = Union(DiferençaDeIntervalos, Celula)
            End If
        End If
    Next

End Function

Logo no início é feita uma verificação para saber se Intervalo1 ou Intervalo2 estão vazios. Caso algum esteja vazio, uma mensagem de erro aparecerá e a execução se encerrará. Lembre-se que Union e Intersect não aceitam intervalos vazios. Em seguida, são criadas duas variáveis: Celula e Interseccao, sendo que esta última logo recebe o valor da intersecção do Intervalo1 e Intervalo2.

Por fim, uma estrutura de repetição analisa cada célula de Intervalo1 e verifica se a intersecção dela com a variável Interseccao está vazia, o que significa que a célula não pertence à intersecção e, portanto, deve ser fazer parte do resultado. Então é feita uma outra verificação para saber se o resultado atualmente está vazio. Caso positivo, recebe a célula em questão, caso contrário faz uma união de seu conteúdo com a célula.

Vamos criar uma sub-rotina para saber se a função funciona corretamente:

Sub TestarDiferençaDeIntervalos()

    Dim Intervalo1 As Range
    Dim Intervalo2 As Range

    Set Intervalo1 = Range("A1:D15")
    Set Intervalo2 = Range("C3:E5")

    DiferençaDeIntervalos(Intervalo1, Intervalo2).Interior.Color = vbYellow

End Sub

Ao executar o código você verá que as células entre A1 e D15 ganham fundo amarelo, com exceção das células entre C3 e D5, nossa função está funcionando perfeitamente.

Assim, podemos alterar nossa rotina-exemplo de formatação de tabela vista no começo para desconsiderar um cabeçalho na primeira linha:

Sub FormatarTabela()

    Dim Tabela As Range
    Set Tabela = Range("A1").CurrentRegion
   
    DiferençaDeIntervalos(Union(Intersect(Tabela, Columns(1)), _
        Intersect(Tabela, Columns(3))), Rows(1)).HorizontalAlignment = xlCenter
   
End Sub

Se você executar esse código atualizado verá que as células A1 e C1 não foram centralizadas como na versão anterior. Se seu cabeçalho usa as duas primeiras linhas você pode substituir Rows(1) por Union(Rows(1), Rows(2)).

Vamos fazer uma função para o outro tipo de diferença, a diferença simétrica, cujo código tem poucas mudanças:

Function DiferençaSimétrica(Intervalo1 As Range, Intervalo2 As Range) As Range

    If Intervalo1 Is Nothing Then
        Err.Raise Number:=603, Description:="O argumento Intervalo1 está vazio"
    ElseIf Intervalo2 Is Nothing Then
        Err.Raise Number:=604, Description:="O argumento Intervalo2 está vazio"
    End If

    Dim Celula As Range
    Dim Interseccao As Range
    Dim Uniao As Range

    Set Interseccao = Intersect(Intervalo1, Intervalo2)
    Set Uniao = Union(Intervalo1, Intervalo2)

    For Each Celula In Uniao
        If Intersect(Celula, Interseccao) Is Nothing Then
            If DiferençaSimétrica Is Nothing Then
                Set DiferençaSimétrica = Celula
            Else
                Set DiferençaSimétrica = Union(DiferençaSimétrica, Celula)
            End If
        End If
    Next

End Function

Você pode alterar a sub-rotina de teste para testar esta função, bastando trocar o nome. O resultado será as mesmas células com fundo amarelo da outra função mais as células entre E3 e E5, que são do segundo intervalo.

Lembre-se que estas funções retornam intervalos, portanto você deve colocar uma linha com Option Private Module no começo do módulo para impedir o uso destas funções em células na planilha.

Espero que este artigo seja útil. Se tiver alguma sugestão de pauta, deixe nos comentários. Até o próximo artigo!

Pedro Martins


Pós-graduando em Business Intelligence e Big Data pela Faculdade Impacta de Tecnologia. Formado em Tecnologia em Eletrônica Digital com Ênfase em Microprocessadores

Autor Pedro Martins

Esta é uma breve descrição no bloco de autor sobre o autor. Você edita-lo, no html
«
Proxima
Postagem mais recente
»
Anterior
Postagem mais antiga

Nenhum comentário

Comentarios