✔ Programação GLOBAL®: VBA Excel - Array - Carregando o conteúdo de uma célula num vetor.

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