Este fórum está sendo desativado

[Stickdaleh]

Boa tarde, pessoal! Tudo bem?

Estou precisando montar períodos entre datas por pessoa nas colunas que estão com o campo preenchido como "SEM".

Por exemplo:
No primeiro ficaria de 03/1983 até 06/1992, sendo que a pessoa pode ter n períodos pois pode ter documentações quebradas.
Ao invés de ter que digitar 03/1983, 04/1983,05/1983....

Em anexo coloco a planilha que contém as informações e um modelo de mais ou menos como eu gostaria que ficasse, não precisa ser como está no modelo.

Desde já, grato pela atenção de todos!

[osvaldomp]

Olá, @Stickdaleh .

Junte as planilhas PERÍODOS DE CÁLCULO e FGTS PAGO FALTANTE em um só arquivo e rode o código abaixo. Aqui rodou em aprox. 10 seg.

A planilha FGTS PAGO FALTANTE deverá permanecer vazia antes de rodar o código, deixe somente os cabeçalhos nas linhas 1 a 3.

Código: Selecionar todos

Sub BuscaPeríodos()
 Dim RE As Range, fndS As Range, fndC As Range, k As Long, fAdd As Range, LC As Long
  Application.ScreenUpdating = False
  With Sheets("PERÍODOS DE CÁLCULO")
   Sheets("FGTS PAGO FALTANTE").[P2] = Time
   .Range("B2:B" & .Cells(Rows.Count, 2).End(3).Row).Copy Sheets("FGTS PAGO FALTANTE").[A4]
   LC = .Cells(1, Columns.Count).End(1).Column: Set fAdd = [A1]
   For Each RE In .Range("B2:B" & .Cells(Rows.Count, 2).End(3).Row)
    Do
     Set fndS = .Rows(RE.Row).Find("SEM", .Cells(RE.Row, 2 + k), , , xlByColumns, xlNext)
     If fndS.Address = fAdd.Address Then k = 0: Set fAdd = [A1]: Exit Do
     If Not fndS Is Nothing Then
      Sheets("FGTS PAGO FALTANTE").Cells(RE.Row + 2, Columns.Count).End(1)(1, 2) = .Cells(1, fndS.Column)
      If fAdd = [A1] Then
       Set fAdd = .Rows(RE.Row).Find("SEM", .Cells(RE.Row, 2 + k), , , xlByColumns, xlNext)
       Set fndS = fAdd
      Else
       Set fndS = .Rows(RE.Row).Find("SEM", .Cells(RE.Row, 2 + k), , , xlByColumns, xlNext)
      End If
      Set fndC = .Rows(RE.Row).Find("COM", .Cells(RE.Row, fndS.Column), , , xlByColumns, xlNext)
      If Not fndC Is Nothing Then
       Sheets("FGTS PAGO FALTANTE").Cells(RE.Row + 2, Columns.Count).End(1)(1, 2) = .Cells(1, fndC.Column - 1)
       k = fndC.Column
      'Else: MsgBox "COM não encontrado": Exit Do
      End If
     End If
    Loop
   Next RE
  End With
  Sheets("FGTS PAGO FALTANTE").[P3] = Time
End Sub