Este fórum está sendo desativado

[hMiguel]

Boa tarde,

Precisa de ajuda na criação de uma macro, para comparar 2 condições e achar o último dia, sem interrupções

em anexo um ficheiro com o exemplo.

Resumindo:

copiar de A2:C2 para h2:j2, verificar se na A3 = H2 e B3=I2, se sim, verificar se a data C3 tem mais 1 dia, se sim, verificar a linha 4, A4 = H2 e B4=I2, caso não sejam iguais, preencher j2 com a data de C3, caso sejam iguais e sempre mais 1 dia, fazer repetidamente, até achar o último dia.

Desde já, agradeço a vossa disponibilidade.

[osvaldomp]

#
Experimente:

Código: Selecionar todos

Sub ReplicaDadosV3()
 Dim k As Long, m As Long, LR As Long
  Application.ScreenUpdating = False
  If [H2] <> "" Then Range("H2:K" & Cells(Rows.Count, 8).End(3).Row) = ""
  LR = Cells(Rows.Count, 1).End(3).Row
  For k = 2 To LR
   Cells(k, 1).Resize(, 3).Copy Cells(Rows.Count, 8).End(3)(2)
   m = k
lwp:
   If Cells(m, 1) <> Cells(m + 1, 1) Or Cells(m, 2) <> Cells(m + 1, 2) Then
    Cells(m, 3).Copy Cells(Rows.Count, 11).End(3)(2)
   ElseIf Cells(m, 1) = Cells(m + 1, 1) And Cells(m, 2) = Cells(m + 1, 2) And _
         Cells(m, 1) = Cells(m + 2, 1) And Cells(m, 2) = Cells(m + 2, 2) Then
    If Cells(m + 1, 3) - Cells(m, 3) = 1 Then
     m = m + 1: k = k + 1: GoTo lwp
    Else: Cells(m, 3).Copy Cells(Rows.Count, 11).End(3)(2)
    End If
   ElseIf Cells(m, 1) = Cells(m + 1, 1) And Cells(m, 2) = Cells(m + 1, 2) And _
         Cells(m, 1) <> Cells(m + 2, 1) Or Cells(m, 2) <> Cells(m + 2, 2) Then
    If Cells(m + 1, 3) - Cells(m, 3) = 1 Then
     Cells(m + 1, 3).Copy Cells(Rows.Count, 11).End(3)(2): k = k + 1
    Else: Cells(m, 3).Copy Cells(Rows.Count, 11).End(3)(2)
    End If
   End If
  Next k
End Sub

[hMiguel]

é isso mesmo, muito, muito obrigado Osvaldo