VBA Excel - Separar um endereço em várias colunas

Dezembro 2016



Introdução


Esta funcionalidade divide os endereços em várias colunas e com diversas configurações.

Ele permite que você selecione e/ou exiba, com ou sem caixa postal.

Os detalhes dos endereços podem ser de qualquer formato.


Exemplo (endereço em Paris, França):
  • 12 tolbiac 75005 PARIS
  • 12 Rue des Egletières BP 100 75008 PARIS
  • 12 rue tolbiac 75005 PARIS
  • 12 Rue des Egletières BP 100 75008 PARIS
  • 12 Egletières BP 100 75008 PARIS
  • 12 Rue Egletières BP 100 75008 PARIS


Resultado com a Caixa Postal selecionada e inversão da rua e do número

Resultado sem a a PO Box e sem a inversão de colunas


As opções são explicadas no código.

Código


Colocar em um módulo público.
Option Explicit    

Sub SepareAdresse()    
Dim WkSource As Worksheet, WkDest As Worksheet    
Dim Colsource As Integer, LigSource As Integer, Lig As Long, UB As Byte    
Dim ColDest As Integer, LigDest As Long, TB, i As Integer, e As Integer    
Dim OrdreDest()    
    Set WkSource = Sheets("Planilha1") 'Planilha onde se encontram os endereços a serem divididos    
    'Nota : se os endereços estiverem em outra pasta começar por    
    'Set WkSource = Workbooks("PlanilhaFonte.xls").Sheets("Planilha1")    
    ColunaFonte = 2 'coluna onde se encontram os endereços a serem divididos - aqui "B"    
    LinhaFonte = 4 'Primeira linha onde se encontram endereços a serem divididos - aqui "4"    
        
    Set WkDest = Sheets("Planilha2") Planilha onde colocar os dados divididos    
    'Nota: se os destinos estiverem em outra pasta começar por       
    'Set WkDest = Workbooks("PlanilhaDeDestino.xls").Sheets("Planilha2")    
    ColunaDeDestino = 3 'Primeira coluna onde colocar os endereços divididos - aqui "C"    
    LinhaDeDestino = 3 'Primeira linha onde colocar os endereços divididos  
        
    'Mudar a ordem das células    
    'Exemplo : para ter    
    'rue des Abeilles | 143 | Bt 3 | 65677 | LaVille    
    OrdreDest = Array(1, 0, 2, 3, 4)    
        
    'No exemplo, não modificaremos a ordem das colunas,    
    'Se houver endereços, com ou sem PO Box, selecione 4 colunas    
    'OrdemDeDestino = Array(0, 1, 2, 3, 4)    
    'Se não tiver nenhum "Bt" (prédio), colocar uma coluna a menos    
    'OrdemDeDestino = Array(0, 1, 2, 3)    
        
    With WkSource    
        For Linha = LinhaFonte To .Cells(65536, ColunaFonte).End(xlUp).Row    
            On Error GoTo Erreur  ' se um endereço não for válido    
            TB = Split(.Cells(Linha, ColunaFonte), " ")    
            UB = UBound(TB) ' - 1    
            For i = 1 To UB    
                If Not IsNumeric(TB(i + 1)) Then    
                    If i > 1 Then TB(1) = TB(1) & " " & TB(i)    
                Else    
                    Exit For    
                End If    
            Next i    
            If UBound(TB) < 4 Then    
                ReDim Preserve TB(4)    
                TB(4) = TB(3): TB(3) = TB(2)    
            End If    
            If TB(i + 1) < 300 Then  'há um PO Box    
                If UBound(OrdreDest) = 4 Then    
                    TB(2) = TB(i) & " " & TB(i + 1)    
                    TB(3) = TB(i + 2): TB(4) = TB(i + 3)    
                Else 'mas não deve ser exibida    
                    TB(2) = TB(UBound(TB) - 1): TB(3) = TB(UBound(TB))    
                End If    
            Else ' não tem caixa postal    
                If i > 1 Then TB(1) = TB(1) & " " & TB(i)    
                If UBound(OrdreDest) = 4 Then 'o PO Box é opcional mas não está presente    
                    TB(2) = ""    
                    TB(3) = TB(UBound(TB) - 1): TB(4) = TB(UBound(TB))    
                Else    
                    TB(2) = TB(UBound(TB) - 1): TB(3) = TB(UBound(TB))    
                End If    
            End If    
                For e = 0 To UBound(OrdreDest)     
                    WkDest.Cells(LinhaDeDestino, ColunaDeDestino).Offset(, OrdemDeDestino(e)) = TB(e)    
                Next e    
                LinhaDeDestino = LinhaDeDestino + 1    
Passe:    
        Next Lig    
    End With    
Exit Sub    
Erro:    
    Resumo Passe    
End Sub

Observação


Caso você tenha uma configuração de endereço que não esteja incluído neste exemplo, favor colocar um comentário, com o exemplo do endereço a ser levado em conta, para que eu possa adicioná-lo a esta funcionalidade.


Tradução feita por Lucia Maurity y Nouira

Veja também :
Este documento, intitulado « VBA Excel - Separar um endereço em várias colunas »a partir de CCM (br.ccm.net) está disponibilizado sob a licença Creative Commons. Você pode copiar, modificar cópias desta página, nas condições estipuladas pela licença, como esta nota aparece claramente.