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.

bernardess@gmail.com