Ir ao conteúdo
  • Cadastre-se

Excel procurar valor por linha, e se não encontrado em outra aba, substituir


Posts recomendados

 

minha macro abaixo não faz uma das tarefas, que é ver os valores da aba Data - coluna AV, se existe na aba Week Update - coluna AK, e caso só exista da aba Data, então o respectivo valor na Coluna AT, mudar para "Historical"

planilha aqui

 

Sub DataUpdate()
   Dim Dary As Variant, Hary As Variant, Uary As Variant, Nary As Variant, Nhary As Variant
   Dim i As Long, c As Long, UsdRws As Long, nr As Long
   Dim Dic As Object
   
   Application.ScreenUpdating = False
   Worksheets("Data").Unprotect Password:="Henkel2020"
   

   Set Dic = CreateObject("scripting.dictionary")
   
   With Sheets("Week Update")
      UsdRws = .Range("C" & Rows.Count).End(xlUp).Row
      Uary = .Range("A3:AK" & UsdRws)
   End With
   
   With Sheets("Data")
      UsdRws = .Range("C" & Rows.Count).End(xlUp).Row
      Dary = .Range("AV3:AV" & UsdRws).Value2
      Hary = .Range("AT3:AT" & UsdRws).Value2
   End With
   
   For i = 1 To UBound(Dary)
      Dic(Dary(i, 1)) = i
   Next i
   
   With Sheets("Data")
      Dary = .Range("A3:AJ" & UsdRws).Value2
   End With
   
   ReDim Nary(1 To UBound(Uary), 1 To 36)
   For i = 1 To UBound(Uary)
      If Dic.Exists(Uary(i, 37)) Then
      
         For c = 1 To 36
            Dary(Dic(Uary(i, 37)), c) = Uary(i, c)
         Next c
   
         If Hary(Dic(Uary(i, 37)), 1) = "Historical" Then Hary(Dic(Uary(i, 37)), 1) = ""
       
      Else

         nr = nr + 1
         For c = 1 To 36
            Nary(nr, c) = Uary(i, c)
         Next c
         
         Hary(i, 1) = "Historical"  ' what there are in "Data" but do not exists on "Week Update", the value is not changed to "Historical"
         
      End If
   Next i
   
   With Sheets("Data")
      
      .Range("A3:AJ" & UsdRws).Value = Dary
      .Range("AT3:AT" & UsdRws).Value = Hary
      If nr > 0 Then
         .Range("A" & UsdRws + 1).Resize(nr, 36).Value = Nary
      End If
   End With
  
  Sheets("Week Update").ListObjects(1).DataBodyRange.EntireRow.Delete
  Sheets("Week Update").Range("Update[Document NumberDocument Line Number]") = "=[@[Document Number]]&[@[Document Line Number]]"
  
  Worksheets("Data").Protect Password:="Henkel2020", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, UserInterfaceOnly:=True

  Worksheets("Data").EnableOutlining = True
  
  Application.ScreenUpdating = True
    
End Sub


 

Link para o post
Compartilhar em outros sites

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

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

×
×
  • Criar novo...

Aprenda a ler resistores e capacitores

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!