Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Evento Worksheet.Change (Excel)

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
MANUEL LOBATO
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Mai 29, 2017 8:27 am

Evento Worksheet.Change (Excel)

Mensagem por MANUEL LOBATO »

Bom dia!
Solicito ajuda para melhora na macro do arquivo anexo.
Quando seleciono o campo CATFIM (coluna "B" da planilha CADASTRO) a macro executa busca da DESCRICAO na planilha CID.
Entretanto ela faz a busca de todos os dados inseridos na coluna "B", preciso que ela faça apenas da célula que foi preenchida/alterada.
Na limpeza da célula ocorre o seguinte: se eu deletar o conteúdo de qualquer célula da coluna "B" ele limpa todos os campos seguintes da coluna "C", preciso que limpe apenas da célula lateral direita da coluna "C"

Muito obrigado!

MANUEL LOBATO
Anexos
CID 10.zip
(24.21 KiB) Baixado 226 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


JValq
Manda bem
Manda bem
Mensagens: 101
Registrado em: Qua Abr 27, 2011 7:34 pm
Localização: São Paulo/SP

Re: Evento Worksheet.Change (Excel)

Mensagem por JValq »

Bom dia!

Veja este código atende:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Range("A:A").EntireColumn.AutoFit
    Else
        Range("A:A").EntireColumn.AutoFit
    End If
    
    If Target.Column = 2 Then
        If Cells(Target.Row, 2).Value <> "" Then
            Cells(Target.Row, 3).Value = WorksheetFunction.VLookup(Target.Value, Sheets("CID").[A1].CurrentRegion, 2, 0)
        Else
            Cells(Target.Row, 3).Value = ""
        End If
    End If
End Sub
Abraço


MANUEL LOBATO
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Seg Mai 29, 2017 8:27 am

Re: Evento Worksheet.Change (Excel)

Mensagem por MANUEL LOBATO »

Ok.
Muito obrigado!


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder