Ir ao conteúdo
  • Cadastre-se

Excel Otimizar a Macro (Metodos: Match; Find; Dic)


Posts recomendados

Boa noite,

 

alguém sabe como consigo deixar mais intuitivo e rápido a macro abaixo ?

 

 

linha = 3

Do While Sheets("Data").Cells(linha, "C") <> Empty
        Var3 = Application.Match(Sheets("Data").Cells(linha, "AV").Value, Sheets("Week Update").Columns(37),  0)
        
        If WorksheetFunction.IsError(Var3) Then 'caso 3: existe uma linha na planilha primária (Data) que foi deletada da semana atual(Week Update)
            linha_apagada = linha
            Sheets("Data").Cells(linha, "AT") = "Historical"
        End If
        
        linha = linha + 1
Loop

 

o resto do código está como abaixo, mas parte dele não funciona como preciso (onde está com o comentário), e não estou conseguindo consertar, mas seria basicamente o código acima, só que chique como abaixo, e inserido no esquema abaixo:

 

basicamente a parte que falta, é : se tem na aba data, checando a coluna AV com a aba Week Update com a coluna AK, e não existe na Week Update, então a linha checada na aba Data coluna AT fica como "Historical"

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"     'eu acho que essa parte não ta funcionando, que seria, se não achar o valor da coluna [Data] AV em [Week Update] AK, então [Data] AT, fica com o valor "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
         .Range("AT" & UsdRws + 1).Resize(nr, 1).Value = Nhary
      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

 

 

após rodar a macro, se tiver certo os seguintes valores da coluna AV, ficarão como "Historical", na coluna AT;

 

40811073610

40820554010

40823667510

 

arquivo aqui

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...

minicurso-montagem-popup.jpg

MINICURSO GRÁTIS!

Como ganhar dinheiro montando computadores!

CLIQUE AQUI E INSCREVA-SE AGORA MESMO!