none
Como estender pesquisa CEP às células subsequentes? RRS feed

  • Pergunta

  • Boa tarde,

    Tenho uma pesquisa CEP onde digito o CEP na célula A1 da Planilha Plan1 e ele lança as informações na planilha Plan2, até ai tudo certo!
    Mas tenho que fazer uma lista de cep's fazendo mesma coisa nas células abaixo (A2, A3, A4, A5, A6...).

    Gostaria de saber se há uma forma mais fácil (e menos pesada pro sistema) de aplicar essa busca por cep nas células A2, A3, A4... sem ser copiando o código novamente e alterar as referências de célula... Ou tem que ser na mão grande mesmo?

    O código é esse:

    Sub lsPesquisaCEP(ByVal sCEP As String)
        On Error GoTo TratarErro
        
        Range("Plan2!a1:H1").Clear
        
        If sCEP <> "" Then
            With ActiveWorkbook.XmlMaps("webservicecep_Mapa")
                .ShowImportExportValidationErrors = False
                .AdjustColumnWidth = True
                .PreserveColumnFilter = False
                .PreserveNumberFormatting = False
                .AppendOnImport = False
            End With
            ActiveWorkbook.XmlImport URL:= _
                "http://republicavirtual.com.br/web_cep.php?cep=" & sCEP, ImportMap:= _
                Nothing, Overwrite:=False, Destination:=Range("Plan2!$a$1")
                
                
        End If
            
        Calculate
        
    Sair:
        Exit Sub
    TratarErro:
        MsgBox "CEP não cadastrado!"
        GoTo Sair
        Resume
    End Sub
    
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Address = "$A$1" Then
            lsPesquisaCEP (Target.Value)
        End If
    End Sub
    



    Desde já, obrigado.

    quarta-feira, 17 de dezembro de 2014 19:57

Respostas

  • Me desculpe, esqueci a segunda parte:

    rivate Sub Worksheet_Change(ByVal Target As Range)
      If Target.Column = 1 Then
        lsPesquisaCEP (Target.Value)
      End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 18 de dezembro de 2014 22:21
    Moderador

Todas as Respostas

  • Sub lsPesquisaCEP(ByVal sCEP As String)
      Dim l As Long
      
      On Error GoTo TratarErro
      
      Range("Plan2!a1:H1").Clear
      
      If sCEP <> "" Then
        For l = 1 To Cells(Rows.Count, "A").End(xlUp).Row
          With ActiveWorkbook.XmlMaps("webservicecep_Mapa")
            .ShowImportExportValidationErrors = False
            .AdjustColumnWidth = True
            .PreserveColumnFilter = False
            .PreserveNumberFormatting = False
            .AppendOnImport = False
          End With
          ActiveWorkbook.XmlImport URL:= _
          "http://republicavirtual.com.br/web_cep.php?cep=" & sCEP, ImportMap:= _
          Nothing, Overwrite:=False, Destination:=Range("Plan2!$a$" & l)
        Next l
      End If
      Calculate
      
    Sair:
      Exit Sub
    TratarErro:
      MsgBox "CEP não cadastrado!"
      GoTo Sair
      Resume
    End Sub
    
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Address = "$A$1" Then
        lsPesquisaCEP (Target.Value)
      End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 17 de dezembro de 2014 21:04
    Moderador
  • Não consegui fazer funcionar aqui Felipe, quando coloco um novo cep em A2 da Plan1, nada aparece na segunda linha da Plan2.


    quarta-feira, 17 de dezembro de 2014 21:20
  • Me desculpe, esqueci a segunda parte:

    rivate Sub Worksheet_Change(ByVal Target As Range)
      If Target.Column = 1 Then
        lsPesquisaCEP (Target.Value)
      End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 18 de dezembro de 2014 22:21
    Moderador
  • Muito obrigado. Valeu pela força!
    sexta-feira, 19 de dezembro de 2014 19:07