Arquivo mensais:January 2011

Excel, Microsoft Office, VBA

VBA – Concatenando Ranges (Função CONCATENAR)

3 Comentários

Velha conhecida dos veteranos de Excel, a função CONCATENAR permite que você faça a união de textos em contidos em células. O único problema da função é que, quando se quer concatenar células que estejam na sequência, não é possível informar o Range.

Por exemplo, caso o texto que se deseja concatenar esteja entre A1 e A10, você precisará usar a função da seguinte maneira:

=CONCATENAR(A1;A2;A3;A4;A5;A6;A7;A8;A9;A10)

Não seria mais simples se isto pudesse ser feito?

=CONCATENAR(A1:A10)

Para isso, nada melhor que uma porção de código VBA. O pessoal do site Excel Tips publicou um código que possibilita exatamente isso. Duas Funções foram disponibilizadas, como mostra o código abaixo.

Function Concat1(myRange As Range, Optional myDelimiter As String)
    Dim r As Range
 
    Application.Volatile
    For Each r In myRange
        Concat1 = Concat1 & r & myDelimiter
    Next r
    If Len(myDelimiter) > 0 Then
        Concat1 = Left(Concat1, Len(Concat1) - Len(myDelimiter))
    End If
End Function
 
Function Concat2(myRange As Range, Optional myDelimiter As String)
    Dim r As Range
 
    Application.Volatile
    For Each r In myRange
        If Len(r.Text) > 0 Then
            Concat2 = Concat2 & r & myDelimiter
        End If
    Next r
    If Len(myDelimiter) > 0 Then
        Concat2 = Left(Concat2, Len(Concat2) - Len(myDelimiter))
    End If
End Function

Nas duas, há um segundo parâmetro, opcional, que é o delimitador, que é um texto que irá separar todas os textos contidos na célula do range informado. Uma mão na roda. A diferença está em que na primeira (Concat1), caso uma das células do range esteja vazia, ele vai repetir o delimitador. No caso da Concat2, o problema é tratado. A figura abaixo mostra o exemplo em ação.

Exemplo de uso das Funções de Concatenação de Ranges
Exemplo de uso das Funções de Concatenação de Ranges

Bom proveito!

Referências

http://excel.tips.net/Pages/T003062_Concatenating_Ranges_of_Cells.html

Excel, Microsoft Office, Outlook

VBA – Escrevendo números por extenso – Parte 2

2 Comentários

Não tem coisa melhor do que a comunidade. A troca de informações gera mais informação, que por fim, acaba resultando em ajuda para muita gente, sem sequer percebermos.

O colega João Henrique Botelho de Amorim encontrou neste site a função em VBA que possibilitava escrever números por extenso. Utilizando-a, descobriu alguns bugs e melhorias, decidindo compartilhar conosco tais mudanças. Abaixo segue a versão disponibilizada pelo colega:

Public Function PorExtenso(ByVal n As Double) As String
' Excel VBA - Write numbers in full - Escrever números por extenso
' Macro adaptada, corrigida e comentada em 10/01/2011 por João Henrique Amorim 
' E-mail: jhbamorim@yahoo.com
' Fonte: http://www.tomasvasquez.com.br/
' Alguns problemas solucionados:
'-Problema com quatrocentos, seiscentos, setecentos (tudo que tenha "centos" no nome). "401" era escrito: "quatrocento e s um"
'-Espaço duplo sempre após ocorrência de "e": "um mil e  um"; "quinhentos e  um"
'-Falta um "e" em 1200, 1300, 1400,...2200,.... Escrevia: "dois mil duzentos"
'-Não escreve números maiores que 10.000 (10.005 é escrito como "cinco"). Já que isso não é um problema no meu caso, bastou usar um if inicial para impedir números maiores que esse.
Dim num As Double, Unid As Variant, Dezen As Variant, Centen As Variant
 
    Unid = Array("", "um", "dois", "três", "quatro", "cinco", _
                 "seis", "sete", "oito", "nove", "dez", "onze", "doze", _
                 "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
                 "dezoito", "dezenove", "vinte")
    Dezen = Array("", "dez", "vinte", "trinta", "quarenta", _
                  "cinquenta", "sessenta", "setenta", "oitenta", "noventa")
    Centen = Array("", "cento", "duzentos", "trezentos", _
                   "quatrocentos", "quinhentos", "seiscentos", _
                   "setecentos", "oitocentos", "novecentos", "mil")
    'Essa função não escreve números maiores que 9.999
    If n > 9999 Then PorExtenso = "Número deve ser menor que 10.000": Exit Function
 
    num = n
    PorExtenso = ""
    If n = 0 Then
        PorExtenso = "zero"
    End If
    If (n \ 1000) > 0 And n \ 1000 < 10 Then 'O número possui milhares?
        PorExtenso = Unid(n \ 1000) & " mil " 'Então escreve a unidade seguida da palavra mil
    End If
    n = n - (n \ 1000) * 1000 'Agora n vai apenas até as centenas do número
 
    If n > 100 Then 'Possui centenas?
        PorExtenso = PorExtenso & Centen(n \ 100) 'Junta-as ao final da frase
    End If
    If n = 100 Then
        PorExtenso = PorExtenso & " cem" 'Se for 100 apenas junta "cem" ao final da frase
        GoTo Prossiga 'E vai para a concatenaçao final das coisas na string
    End If
    n = n - (n \ 100) * 100 'Agora pega apenas ate as dezenas.
 
    If n >= 20 And n < 100 Then 'Se as dezenas estiverem entre 20 e 99 junte-as ao fim da frase
        PorExtenso = PorExtenso & " " & Dezen(n \ 10)
    End If
    If n > 0 And n < 20 Then 'Entre 1 e 19 escreve a unidade no fim da frase
        PorExtenso = PorExtenso & " " & Unid(n)
        GoTo Prossiga 'E vai para a concatenaçao final das coisas na string
    End If
    n = n - (n \ 10) * 10 'Pega só a unidade
 
    If n > 0 Then 'Junta o nome da unidade ao fim da frase,
        PorExtenso = PorExtenso & " " & Unid(n)
    End If 'na qual ja deve constar os milhares e dezenas SE houver...
Prossiga:
    If num Mod 10 <> 0 Then
        If InStr(1, PorExtenso, "vinte", 1) = 0 Then
            If InStr(1, PorExtenso, "trinta", 1) = 0 Then
                If InStr(1, PorExtenso, "enta", 1) > 0 Then
                    'Sempre lembrando de suprimir todos os espaços após o "e"
                    PorExtenso = Application.Substitute(PorExtenso, "enta", "enta e")
                End If
            End If
        End If
    End If
    If num Mod 10 <> 0 Then
        If InStr(1, PorExtenso, "vinte", 1) > 0 Then
            If InStr(1, PorExtenso, "trinta", 1) = 0 Then
                If InStr(1, PorExtenso, "enta", 1) = 0 Then
                    PorExtenso = Application.Substitute(PorExtenso, "vinte", "vinte e")
                End If
            End If
        End If
    End If
    If num Mod 10 <> 0 Then
        If InStr(1, PorExtenso, "vinte", 1) = 0 Then
            If InStr(1, PorExtenso, "trinta", 1) > 0 Then
                If InStr(1, PorExtenso, "enta", 1) = 0 Then
                    PorExtenso = Application.Substitute(PorExtenso, "trinta", "trinta e")
                End If
            End If
        End If
    End If
    'Troca-se de "cento" para "cento e" apenas se o nome NAO contiver "centos" para não destruir quatroCentos, seisCentos...etc
    If num Mod 100 <> 0 And InStr(1, PorExtenso, "centos", 1) <= 0 Then
        If InStr(1, PorExtenso, "ento", 1) > 0 Then
            PorExtenso = Application.Substitute(PorExtenso, "cento", "cento e")
        End If
    End If
    'Troca-se de "entos" para "entos e" apenas se o nome NAO contiver "centos" para não destruir quatroCentos, seisCentos...etc
    If num Mod 100 <> 0 And InStr(1, PorExtenso, "centos", 1) <= 0 Then 'Aqui mora o problema!
        If InStr(1, PorExtenso, "entos", 1) > 0 Then
            PorExtenso = Application.Substitute(PorExtenso, "entos", "entos e")
        End If
    End If
    'Agora que os "entos" já foram resolvidos, resolvamos os centos de quatrocentos, seiscentos, etc
 
    If num Mod 100 <> 0 And InStr(1, PorExtenso, "centos", 1) > 0 Then
        If InStr(1, PorExtenso, "centos", 1) > 0 Then
            PorExtenso = Application.Substitute(PorExtenso, "centos", "centos e")
        End If
    End If
 
    'E continua testando os milhares...Tendo agora o cuidado de procurar pelo espaço após o "mil" para que ele não fique duplicado
    If num Mod 1000 <> 0 Then
        'A troca de "mil" por "mil e" está ocorrendo quando após o milhar vier número de 1 a 99
        If (num - (num \ 1000) * 1000) <= 100 Then
            If InStr(1, PorExtenso, "mil ", 1) > 0 Then
                PorExtenso = Application.Substitute(PorExtenso, "mil ", "mil e")
            End If
        End If
 
        'Mas a troca de "mil" por "mil e" também deve ocorrer quando após o milhar vier 200, 300,...,900. Mas não 100! Pois foi tratado no if anterior.
        If (num - (num \ 100) * 100) = 0 And (num - (num \ 1000) * 1000) <> 100 Then
            If InStr(1, PorExtenso, "mil ", 1) > 0 Then
                PorExtenso = Application.Substitute(PorExtenso, "mil ", "mil e ")
            End If
        End If
    End If
 
End Function

De quebra, ainda acrescentou vários comentários úteis para o entendimento do código. Valeu João!

Abraços a todos

Downloads, Excel, VBA

Modelo – Log com as Alterações nas Planilhas

1 Comentário

Mais uma ótima colaboração do nosso fórum.

Este Modelo foi criado pelo Daniel Petralanda Santos da Petrobras em 2002.

Fiz algumas adaptações sómente no layout para explicar melhor o uso.

O que ele faz :

Toda vez que abrimos o Aplicativo é Criado um arquivo de LOG com extensão TXT no diretório aonde se encontra a planilha, e toda alteração é gravado nele encriptada, se abrirem o TXT criado verão que é ilegivel.

Altere qualquer celula em qualquer planilha e depois clique em EXIBIR LOG e selecione o Log, e verá as modificações que foram feitas nas planilhas, em que dia, horario e qual foi a alteração, ou seja qual o valor que era antes e para qual foi alterado.

Se quiser acrescentar mais planilhas tem de copiar o código para essas, clique com o botão direito na planilha escolha exibir código, copie e cole nas plan que acrescentar.

É bem interessante, vale uma ressalva quanto ao arquivo texto criado, o ideal seria alterar na rotina para que o mesmo seja criado em um outro diretorio para evitar que se deletem o mesmo.

Vale a pena baixar e testar.

Download da Planilha

LogAlteracao.rar

Discussões sobre esta planilha estão sendo feitas também no nosso fórum:

http://www.tomasvasquez.com.br/forum/viewtopic.php?f=17&t=769&start=0