- 12 Jan 2021 às 21:14
#61456
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"
https://drive.google.com/file/d/16Z6Vga ... sp=sharing
https://drive.google.com/file/d/16Z6Vga ... sp=sharing
Código: Selecionar todos
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