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: array, cell, matriz, vetor, carregar

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



Nenhum comentário:

Postar um comentário

diHITT - Notícias