Views

...

Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

VBA Excel - Array - Carregando o conteúdo de uma célula num vetor.

Os desenvolvedores sempre precisam lidar com bases de dados esdrúxulas. Às vezes estas tem como fonte planilhas do MS Excel, e invariavelmente precisamos popular as nossas bases de dados com este conteúdo sem qualquer higienização.

Imagine que você tenha uma lista de dados onde uma das colunas contém inúmeros endereços de e-mail da mesma pessoa, ou inúmeros telefones de contato, ou dois ou três endereços de contato, mas a sua tabela tem um campo para cada uma dessas ocorrências.

Isso seria bem trabalhoso não é mesmo?

Suponha que eu tenha uma planilha com o faturamento da minha rede de sorveterias. Mas coloquei tudo nas seguintes 2 colunas:

Faturamento    Cidades
R$ 5,500,00       Abatiá, Altamira do Paraná, Alto Paraíso, Alto Paraná, Alto Piquiri, Altônia
R$ 3.700,00       Campina da Lagoa, Campo Bonito, Campo Mourão, Cândido de Abreu, 
R$ 3.700,00       Godoy Moreira, Goioerê, Grandes Rios, Guaíra, Guairaçá, Guapirama, 

Mas a minha tabela tem 10 campos onde posso desmembrar as cidades, como faço?

Utilizei a função FillCitiesVector (nFrase As String, nOccurs As Single)

Dentro do meu módulo de funções defini uma variável como pública, conforme abaixo:

Public MyNames (1 To 500) As String  ' (500) é o Nº máximo de cidade que podem ser encontradas numa célula.

A minha chamada à função FillCitiesVector é precedida das seguintes linhas de código:

Dim nCharss As Single

Let nCharss = Val (fCountOccur (Range("C" & i).Value, ",")) + 1

' Coloca todas as cidades num vetor.
Call FillCitiesVector(Replace(Range("C" & i).Value, ", ", ","), nCharss)

A função fCountOccur permite contar o número de separadores dentro de uma string, que no nosso caso são as vírgulas.

A função Replace está substituindo as vírgulas seguidas de espaços, apenas por vírgulas sem espaços.

Segue a função FillCitiesVector

Function FillCitiesVector (nFrase As String, nOccurs As Single)
    ' Author:                     Date:               Contact:                 URL:
    ' André Bernardes             16/11/2011 16:41    bernardess@gmail.com     http://inanyplace.blogspot.com/
    ' .
    ' Listening: .

    Dim i As Single
    Dim ponteiro As Single
    Dim nCheck As Boolean
    
    Let nCheck = True

    For i = 1 To nOccurs + 1
        If nCheck Then
            Let MyNames(i) = Mid(nFrase, i, InStr(i, nFrase, ",") - 1)  ' Popula esta dimensão do vetor.
            Let ponteiro = Len(MyNames(i)) + 1                            ' Reposiciona o ponteiro.
            Let nFrase = Trim(Mid(nFrase, ponteiro + 1, 5000))
            Let nCheck = False
        Else
        
            If InStr(1, nFrase, ",") <> 0 Then ' Checa se ainda há mais de uma cidade
                Let MyNames(i) = Mid(nFrase, 1, InStr(1, nFrase, ",") - 1)  ' Popula esta dimensão do vetor.
                Let ponteiro = Len(MyNames(i)) + 1                          ' Reposiciona o ponteiro.
                Let nFrase = Trim(Mid(nFrase, ponteiro + 1, 5000))
            Else
                Exit For
            End If
        End If
    Next
End Function

Segue a função fCountOccur

Public Function fCountOccur (strSource As String, strMatch As String) As String
    ' Author:                     Date:               Contact:                 URL:
    ' André Bernardes             16/11/2011 16:41    bernardess@gmail.com     http://inanyplace.blogspot.com/
    ' .
    ' Listening: .

    Dim iCount As Integer
    Dim iPosition As Integer
    
    Let iCount = 0
    
    For iPosition = 1 To Len(strSource)
        If Mid(strSource, iPosition, 1) = strMatch Then iCount = iCount + 1
    Next
    
    Let fCountOccur = iCount
End Function


Tags: Bernardes, MS, Microsoft, Office, VBA, Excel, code, Array, matriz, vetor, desmembrando, count, occurs

André Luiz Bernardes
A&A® - Work smart, not hard.



eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine