Excel Criar botão com função Procv no VBA

[Zamboni_du]

Boa noite pessoal,

 

Preciso de uma ajuda, gostaria de colocar um botão com o nome incluir onde ele faca a função do Procv localizando uma informação em uma planilha e colando em outra. No caso ele usaria como valor procurado o numero da NF na "Planilha1" buscando na "Planilha2" o KM referente ao numero da NF e colaria na "Planilha1". Isso se repetiria diariamente. Segue abaixo planilha.

Botão incluir.xlsx

[Midori]

@Zamboni_du Veja se resolve. Atribua a macro ao botão incluir,

 

Sub Incluir()
    Dim Area As Range
    
    Set Area = Planilha1.[G2].Resize( _
        Planilha1.[A1].End(xlDown).Row - 1)
    
        Area.FormulaR1C1 = _
            "=VLOOKUP(RC[-1],Planilha2!R7C4:R12C6,3,0)"
        Area.Copy
        Area.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
End Sub

 

[Zamboni_du]

@Midori Muito obrigado pela ajuda, você poderia me explicar passo a passo para entender e aprender? 

@Midori outra coisa se eu quiser fazer o mesmo com a coluna que contem as horas, como faço?

50 minutos atrás, Zamboni_du disse:

@Midori Muito obrigado pela ajuda, você poderia me explicar passo a passo para entender e aprender

 

[Midori]

@Zamboni_du  Em Dim Area As Range faço o declaração da variável Area como Range e com a instrução Set atribuo as células onde quero colocar o km. Para definir as células aumentei o range a partir de [G2], veja que passei para resize o tamanho:

 

Planilha1.[A1].End(xlDown).Row - 1

 

Assim pego a última linha da tabela usando a coluna A como referência (tirei 1 porque faço resize a partir da segunda linha). Como a última linha da tabela da sua planilha é a 44, o comando acima vai retornar o valor necessário para atribuir o intervalo (que no caso tem 43 linhas). Portanto de G2 o range passará a ser G2:G44.

 

Area.FormulaR1C1 = "=VLOOKUP(RC[-1],Planilha2!R7C4:R12C6,3,0)"

 

Aí atribuí a fórmula PROCV. Se a macro terminasse nessa linha ia deixar a fórmula na planilha, mas nas linhas seguintes copio e colo como valor para tirar a fórmula.

 

[Zamboni_du]

@Midori ok, porém essa planilha é um exemplo a original ela não termina na linha 44 ela vai aumentando dia a dia, outra coisa eu também preciso que os valores da coluna hora também sejam inseridos na planilha1, o que eu preciso alterar? Eu tentei porém deu erro.

[Midori]

@Zamboni_du A macro sempre vai pegar a última linha, faça um teste com mais e veja que funciona.

 

Para os valores das horas acrescente esta linha no código,

 

Area.Offset(0, 1).FormulaR1C1 = _
    "=VLOOKUP(RC[-2],Planilha2!R7C4:R12C7,4,0)"

 

[Zamboni_du]

@MidoriBoa tarde,

 

Desculpa reabrir o tópico mas eu comecei a aplicar e percebi uma coisa, quando eu lanço os dado de ontem funciona certinho, porém quando eu lanço os dados de hoje os dados de ontem são sobrescritos pela formula conforme anexo. Você pode me ajudar? 

Botão incluir.xlsx

[Midori]

@Zamboni_du Como novos dados serão acrescentados a macro pode pegar o intervalo da última linha de G até a última da tabela. Veja se assim resolve,

 

Sub Incluir()
    Dim Area    As Range
    Dim Inicio  As Long
    Dim Fim     As Long
    
    Set Area = Planilha1.[G2]
    Inicio = IIf(Area = "", 1, Area.End(xlDown).Row)
    Fim = IIf(Planilha1.[A2] = "", 1, Planilha1.[A1].End(xlDown).Row)
    
    If Fim - Inicio > 0 Then
        Set Area = Area.Cells(Inicio).Resize(Fim - Inicio)       
        Area.FormulaR1C1 = _
            "=VLOOKUP(RC[-1],Planilha2!R7C4:R12C6,3,0)"
        Area.Offset(0, 1).FormulaR1C1 = _
            "=VLOOKUP(RC[-2],Planilha2!R7C4:R12C7,4,0)"
        With Area.Resize(Area.Rows.Count, 2)
            .Copy
            .PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
    End If
End Sub

 

[Zamboni_du]

@Midori Boa tarde, tudo bem?

 

Deu erro nessa linha:

 

Inicio = IIf(Area = "", 1, Area.End(xlDown).Row)

[Midori]

@Zamboni_du Se for erro 13 deve ser porque tem fórmula retornando #N/D na célula G2. Corrija os erros de fórmula antes de rodar.

[Zamboni_du]

@Midori bom dia,

Realmente era esse o problema, porém o que está acontecendo é que quando eu insiro novas informações o código sobrescreve a formula do dia anterior e lança as novas informações, com isso o que eu lancei do dia anterior fica com o resultado #N/D ao invés do KM e hora.

[Midori]

@Zamboni_du Com o último código que postei isso não acontece mais. Se a planilha já tiver uma tabela com dados contínuo na colunas G a macro só vai aplicar a fórmula a partir da próxima linha em branco dessa coluna. Se ainda tiver problema anexe o arquivo.

[Zamboni_du]

@Midori Bom dia,

 

Segue anexo.Botão incluir.zip

[Midori]

@Zamboni_du O problema é que você mudou as colunas e não ampliou o range que copia e cola especial como valor. E assim a fórmula da hora vai ficar com #N/D quando mudar o valor da planilha Entregas. Aumente o resize para 3 colunas,

 

With Area.Resize(Area.Rows.Count, 3)

 

[Zamboni_du]

@Midori , fiz a alteração porém eu laço os dados do dia 26 e abaixo nos dias 27 e 30 aparece #N/D, então eu lanço os dados do dia 27 e nada acontece, porém se eu apagar #N/D ai sim funciona, o mesmo acontece com o dia 30.

[Midori]

@Zamboni_du O #N/D não é problema da macro, é na forma com está tentando atualizar. Se a busca do procv não encontrar o valor correspondente na planilha Entregas vai dar erro. É isso que aconteceu nessa última planilha porque a NF 5341-1 não tem na planilha Entregas.

 

Você comentou sobre os dados do dia 26, 27 e 30. Para corrigir a planilha, siga estes passos:

1. Apague todos os dados a partir da linha 2 da planilha Dados, deixe apenas os nomes dos campos na linha 1.
2. Na planilha Entregas cole as notas do dia 26.
3. Na planilha Dados cole os dados do dia 26 e rode a macro.
4. Na planilha Entregas cole as notas do dia 27.
5. Na planilha Dados cole os dados do dia 27 e rode a macro.
6. Na planilha Entregas cole as notas do dia 30.
7. Na planilha Dados cole os dados do dia 30 e rode a macro.

 

Seguindo esses passos diga se acontece algum erro.

[Zamboni_du]

@Midori, desculpe pela falta de atenção você já havia explicado porém eu ao invés de começar do zero continuei com a planilha preenchida.

Me tira uma duvida ao aumentar o Range para 3 a fórmula que esta na segunda coluna (coluna Y) é apagada, é possível alterar isso?

Outra coisa é possível inserir a  formula SEERRO para no lugar do erro #N/D aparecer nada?

[Midori]

47 minutos atrás, Zamboni_du disse:

o Range para 3 a fórmula que esta na segunda coluna (coluna Y) é apagada, é possível alterar isso?

É sim, substitua o bloco with,

With Area.Resize(Area.Rows.Count)
    .Copy
    .PasteSpecial xlPasteValues
    .Offset(0, 2).Copy
    .Offset(0, 2).PasteSpecial xlPasteValues
End With

 

[Zamboni_du]

@Midori legal, deu certo, agora sobre a formula SEERRO ante do procv é possível? Para eliminar o erro #N/D.

Outra coisa depois de rodar o código e volta para o inicio da planilha, como faço para ficar onde foi colado a última informação?

[Zamboni_du]

@Midori,

 

Muito obrigado pela ajuda e desculpa pelo incomodo pois pro falta de atenção fiquei repetindo o mesmo erro e te questionando. E acrescentei o código abaixo para limpara as células é bem básico mas funcionou, se tiver uma sugestão agradeceria muito  !!!!

 

    Range("L8:M29").Select
    Selection.ClearContents
    Range("L8").Select

[Midori]

@Zamboni_du O código com os acréscimos da formula e seleção da última linha,

 

Sub Incluir()
    Dim PlanDados   As Worksheet
    Dim Area        As Range
    Dim Inicio      As Long
    Dim Fim         As Long
    
    Set PlanDados = ThisWorkbook.Sheets("Dados")
    Set Area = PlanDados.[X2]
    Inicio = IIf(Area = "", 1, Area.End(xlDown).Row)
    Fim = IIf(PlanDados.[A2] = "", 1, PlanDados.[A1].End(xlDown).Row)
    
    If Fim - Inicio > 0 Then
        Set Area = Area.Cells(Inicio).Resize(Fim - Inicio)
        Area.FormulaR1C1 = _
            "=IF(ISERROR(VLOOKUP(RC[-13],Entregas!R7C5:R26C12,8,0)),""NDA" & _
            """,VLOOKUP(RC[-13],Entregas!R7C5:R26C12,8,0))"
        Area.Offset(0, 2).FormulaR1C1 = _
            "=IF(ISERROR(VLOOKUP(RC[-15],Entregas!R7C5:R26C13,9,0)),""NDA" & _
            """,VLOOKUP(RC[-15],Entregas!R7C5:R26C13,9,0))"
        With Area.Resize(Area.Rows.Count)
            .Copy
            .PasteSpecial xlPasteValues
            .Offset(0, 2).Copy
            .Offset(0, 2).PasteSpecial xlPasteValues
            PlanDados.Activate
            .Cells(Area.Rows.Count).Offset(0, 2).Select
        End With
        Application.CutCopyMode = False
    End If
End Sub

 

[Zamboni_du]

@Midori , ficou top muito obrigado!!!!

Eu estou tentando entender melhor e acrescentei mais duas linhas referente mais duas colunas que quero acrescentar porém não consegui encontrar onde estou errando pois quando rodo o código para acrescentar mais dados ele apaga as informações dos campos anteriores (das colunas quer acrescentei). Você pode verificar onde estou errando?

 

 

Botão incluir.zip

[Midori]

@Zamboni_du A edição do acréscimo das fórmulas está correta, mas a macro não está pagando informações anteriores, só não está removendo as fórmulas de duas colunas. Esta é alteração para resolver isso,

 

With Area.Resize(Area.Rows.Count, 4)
    .Copy
    .PasteSpecial xlPasteValues
    .End(xlDown).Offset(0, 3).Select
End With

 

[Zamboni_du]

@Midori , boa tarde tudo bem?

 

Veja se você pode me ajudar, é possível não repetir os valores iguais ou excluí-los? 

[Midori]

@Zamboni_du Antes de aplicar a fórmula a macro poderia deixar os Clientes sem duplicidade na mesma data. Seria isso?