Ir ao conteúdo
Regras do Clube do Hardware

Excel VBA - Se valor contido é verdadeiro - preencher coluna com outro valor.

ffialho

Por ffialho
em Microsoft Office e similares

 Compartilhar
Ir à solução Resolvido por AfonsoMira,

Posts recomendados

ffialho
 

ffialho

Postado
Postado

Bom dia pessoal, tudo bem?

 

Estou tentando fazer um VBA onde tenho 2 ABAS:

1.Faturado 

2.Recebido

 

o que já consegui via formula ( dps vou jogar para o VBA ) é  identificar se uma NF da aba Faturado está CONTIDA na ABA Recebido - por que isso? porque o sistema inclui caracteres na ABA recebido

NF 1234 - ABA FATURADO sai como 1234#01 na RECEBIDOS - porém podem ter outros caracteres. Planilha exemplo anexo,

 

ABA FATURADO - não tem a data de vencimento da NF, já a recebido possui.

 

O que não consegui  fazer foi: se o valor da CHAVE ( CLIENTE + NF ) da ABA  FATURADO estiver CONTIDO em alguma linha da na linha CHAVE_I da ABA RECEBIDOS - ele preenche com  data de VENCIMENTO na aba FATURADO.

Pode ser que os valores se repitam por algum motivo que desconheco - neste caso, o codigo deve pegar a data mais antiga.

 

estou tentando fazer via VBA porque essa etapa faz parte de um processo que estou tentando automatizar nesse acompanhamaneto, 

 

desde já agradeço!

 

 

AJuda_VBA_Esta_Contido.xlsx

AfonsoMira
 

AfonsoMira

Postado
Postado

Boas @ffialho ,

Veja se isto ajuda:
  

Sub verificarValor()

'Declara Livro
Dim wb As Workbook: Set wb = ThisWorkbook

'Declara Folhas
Dim wsRecebidos As Worksheet: Set wsRecebidos = wb.Sheets("Recebidos")
Dim wsFaturado As Worksheet: Set wsFaturado = wb.Sheets("Faturado")

'Declara Ultimas Linhas das Folhas
Dim UltLinhaRecebidos As Long: UltLinhaRecebidos = wsRecebidos.Cells(wsRecebidos.Rows.Count, "A").End(xlUp).Row
Dim UltLinhaFaturado As Long: UltLinhaFaturado = wsFaturado.Cells(wsFaturado.Rows.Count, "A").End(xlUp).Row

Dim i, x As Long

Dim chaveFaturado As String
Dim chaveRecebidos As String

'Loop por cada linha da Folha Faturado
For i = 2 To UltLinhaFaturado

'Recebe Chave Faturado
chaveFaturado = wsFaturado.Cells(i, 6).Value

'Loop por cada linha da Folha Recebidos
For x = 2 To UltLinhaRecebidos
    
    'Recebe Chave Recebidos
    chaveRecebidos = wsRecebidos.Cells(i, 7).Value
    
    'Se Chave Recebidos contem Chave Faturado então
    If InStr(1, chaveRecebidos, chaveFaturado, vbTextCompare) <> 0 Then
        'Coloca Data vencimento na Folha Faturado
        wsFaturado.Cells(i, 8).Value = wsRecebidos.Cells(i, 6).Value
    End If

Next x

Next i

End Sub

 

  • Curtir 1
ffialho
 

ffialho

Postado
  • Autor
Postado

Olá Afonso 

 

funcionou perfeitamente na planilha que mandei como exemplo. Porém quando fui tentar aplicar em uma outra planilha com a mesma estrutura. Entrou em LOOP e travou o excel. 

 

( vide planilha anexa - com a mesma estrutura, porém em colunas diferentes e com grande quantidade de dados ) 

Deixei exatamente os titulos e posição das colunas dos campos "chaves" que estava tentando utilizar. 

 

ABA FATURADO: CHAVE_I - Coluna AB

ABA RECEBIDOS: CHAVE_II - Coluna U

 

Reforçando o meu problema:
 

se o valor da CHAVE_I ( CLIENTE + NF ) da ABA  FATURADO estiver CONTIDO em alguma linha da na linha CHAVE_II da ABA RECEBIDOS - ele preenche com  data de VENCIMENTO na aba FATURADO. Pode ser que os valores se repitam por algum motivo que desconheco - neste caso, o codigo deve pegar a data mais antiga.

 

qualquer ajuda será bem vinda! 

CONSOLIDACAO_TESTE.xlsx

  • Solução
AfonsoMira
 

AfonsoMira

Postado
  • Solução
Postado 
Sub verificarValor()

'Declara Livro
Dim wb As Workbook: Set wb = ThisWorkbook

'Declara Folhas
Dim wsRecebidos As Worksheet: Set wsRecebidos = wb.Sheets("Recebidos")
Dim wsFaturado As Worksheet: Set wsFaturado = wb.Sheets("Faturado")

'Declara Ultimas Linhas das Folhas
Dim UltLinhaRecebidos As Long: UltLinhaRecebidos = wsRecebidos.Cells(wsRecebidos.Rows.Count, "A").End(xlUp).Row
Dim UltLinhaFaturado As Long: UltLinhaFaturado = wsFaturado.Cells(wsFaturado.Rows.Count, "A").End(xlUp).Row

Dim i, x As Long

Dim chaveFaturado As String
Dim chaveRecebidos As String

'Loop por cada linha da Folha Faturado
For i = 2 To UltLinhaFaturado

'Recebe Chave Faturado
chaveFaturado = wsFaturado.Range("AB" & i).Value

'Loop por cada linha da Folha Recebidos
For x = 2 To UltLinhaRecebidos
    
    'Recebe Chave Recebidos
    chaveRecebidos = wsRecebidos.Range("U" & x).Value
    
    'Se Chave Recebidos contem Chave Faturado então
    If InStr(1, chaveRecebidos, chaveFaturado, vbTextCompare) <> 0 Then
        'Coloca Data vencimento na Folha Faturado
        wsFaturado.Range("AC" & i).Value = wsRecebidos.Range("G" & x).Value
    End If

Next x

Next i

End Sub

Para resolver a questão das colunas novas.

Já para a parte da Data mais antiga terei que pensar em algo.

  • Curtir 1
ffialho
 

ffialho

Postado
  • Autor
Postado

Bom dia Afonso! Muito obrigado pela ajuda!

 

WOW! Funcionou como um relogio! muito obrigado!

 

Também estou pesquisando sobre como fazer esse ajuste das datas ou condicional das datas. Postarei aqui assim que encontrar uma solução

  • Curtir 1
OreiaG
 

OreiaG

Postado
Postado

Veja se ajuda.

 

Soluções por fórmulas matriciais na planilha Faturado.

1. versão MS 365 >> =MÍNIMOSES(Recebidos!G$2:G$39225;Recebidos!U$2:U$39225;AB2&"*")

2. versões anteriores >> =MÍNIMO(SE(ÉNÚM(LOCALIZAR(AB2;Recebidos!U$2:U$39225));Recebidos!G$2:G$39225))

 

Soluções por macro.

Versão MS 365, resultado em Faturado!AE (aprox. 15 seg) 

SSub BuscaChaves365()
 Dim UL As Long
  UL = Sheets("Recebidos").Cells(Rows.Count, "U").End(xlUp).Row
  With Sheets("Faturado")
   .Columns("AE") = ""
   .Range("AE2:AE" & .Cells(Rows.Count, "AB").End(xlUp).Row).Formula = _
     "=MINIFS(Recebidos!G$2:G$" & UL & ",Recebidos!U$2:U$" & UL & ",AB2&""*"")"
   .Columns("AE").Value = .Columns("AE").Value
   .Columns("AE").NumberFormat = "dd/mm/yyyy": .Columns("AE").AutoFit
  End With
End Sub

 

Versões anteriores, resultado em Faturado!AF (aprox 60 seg) 

Sub BuscaChaves()
 Dim UL As Long
  UL = Sheets("Recebidos").Cells(Rows.Count, "U").End(xlUp).Row
  With Sheets("Faturado")
   .Columns("AF") = ""
   .Range("AF2:AF" & .Cells(Rows.Count, "AB").End(xlUp).Row).Formula2 = _
     "=MIN(IF(ISNUMBER(SEARCH(AB2,Recebidos!U$2:U$" & UL & ")),Recebidos!G$2:G$" & UL & "))"
   .Columns("AF").Value = .Columns("AF").Value
   .Columns("AF").NumberFormat = "dd/mm/yyyy": .Columns("AF").AutoFit
  End With
End Sub

 

  • Curtir 1
ffialho
 

ffialho

Postado
  • Autor
Postado

@OreiaG

Tudo bem?

 

Tentei fazer a sua solução rodar na planilha anexa, mas ele não retorna o valor - mas sim 0  ou 01/01/1900.

 

consegue ver onde errei?!

OreiaG
 

OreiaG

Postado
Postado
33 minutos atrás, ffialho disse:

@OreiaG

Tentei fazer a sua solução rodar na planilha anexa, ...

 

Eu coloquei 4 soluções. A qual delas você se refere? 😑

 

A planilha anexa não está anexa. 🤪

ffialho
 

ffialho

Postado
  • Autor
Postado

Teste_VBA_2.xl

 

Olá @OreiaG

Malz! montei o post anterior todo errado!  Estou tentando usar a solução do exemplo la de cima - porque foi muito rápido! 

Quando tentei aplicar neste planilha anexa deu 0  ou 01/01/1900. não alterei nada no código a não ser as colunas.

valeu pela ajuda!!

 

Sub BuscaChaves()

 

Dim UL As Long

 

UL = Sheets("Base_Ajustada_120").Cells(Rows.Count, "U").End(xlUp).Row

     With Sheets("Base214") .Columns("AF") = ""

          .Range("AT2:AT" & .Cells(Rows.Count, "AS").End(xlUp).Row).Formula = _

          "=MIN(IF(ISNUMBER(SEARCH(AS2,Base_Ajustada_120!U$2:U$" & UL & ")),Base_Ajustada_120!A$2:A$" & UL & "))"

.          Columns("AT").Value = .Columns("AT").Value

          .Columns("AT").NumberFormat = "dd/mm/yyyy": .Columns("AT").AutoFit

End With

End Sub

OreiaG
 

OreiaG

Postado
Postado

Olá, @ffialho.

 

UL = Sheets("Base_Ajustada_120").Cells(Rows.Count, "U").End(xlUp).Row

     With Sheets("Base214") .Columns("AF") = ""

Pintei os erros de vermelho acima.

O nome da planilha é "Base_120_Ajustada", e na instrução de baixo faltou alterar a coluna de AF para AT e faltou colocar a instrução na posição correta no código.

Adicionei um SE na fórmula para deixar vazia a célula caso a Chave I não for encontrada na Chave II.

  

Sub BuscaChavesV2()
 Dim UL As Long
  UL = Sheets("Base_120_Ajustada").Cells(Rows.Count, "U").End(xlUp).Row
  With Sheets("Base214")
   .Columns("AT") = ""
   .Range("AT2:AT" & .Cells(Rows.Count, "AS").End(xlUp).Row).Formula2 = _
"=IF(COUNTIF(Base_120_Ajustada!U$2:U$" & UL & ",AS2&""*"")=0,"""",MIN(IF(ISNUMBER(SEARCH(AS2,Base_120_Ajustada!U$2:U$" & UL & ")),Base_120_Ajustada!A$2:A$" & UL & ")))"
   .Columns("AT").Value = .Columns("AT").Value
   .Columns("AT").NumberFormat = "dd/mm/yyyy": .Columns("AT").AutoFit
  End With
End Sub

 

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora
 Compartilhar
Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...