Página 1 de 1

Resumo de Afetações

Enviado: 26 Out 2018 às 15:39
por JCabral
Boa tarde
Mais uma vez pedindo ajuda para encontrar a melhor solução para o meu caso, então é assim:

Tenho uma planilha com dados de determinadas tarefas e tenho afetações e % de afetação a cada tarefa.
Precisava de ter um output que em função de cada nome afetado, me dissesse quais as tarefas e quais as devidas percentagens.

Posso não estar a ser muito claro naquilo que pretendo mas na planilha que anexo está um exemplo claro, sendo que em "DF" estão os dados que preencho e em "OrdemDF" está o OutPut que desejo.

A formatação dos dados tem que ser conforme está na planilha anexa, ou seja não posso transformar em Tabelas e depois filtrar...e tem que ser em VBA porque pretendo automatizar o processo.

Obrigado desde já pela ajuda
Jorge Cabral

Re: Resumo de Afetações

Enviado: 30 Out 2018 às 22:56
por JCabral
Alguma dica de como posso fazer isto?

Obrigado
Jorge Cabral

Re: Resumo de Afetações

Enviado: 31 Out 2018 às 15:03
por osvaldomp
Veja se o código abaixo ajuda.
O resultado será por ordem alfabética dos nomes.
No seu resultado desejado a soma dos percentuais para o Nome4 está incorreta.
Código: Selecionar todos
Sub CondensaDados()
 Dim i As Long, LR As Long, c As Range, k As Range, ws As Worksheet, kAd As String, x As Long
  Application.ScreenUpdating = False
  Set ws = Sheets("OrdemDF")
  If ws.[A9] <> "" Then
   ws.Range("A9", ws.Cells(Rows.Count, 1).End(3)).Resize(, 5).Value = ""
  End If
  
  With Sheets("DF")
   .[T:T].Clear
   LR = .Cells(Rows.Count, 1).End(3).Row
   
   For i = 5 To 14 Step 3
    .Range(.Cells(14, i), .Cells(LR, i)).Copy .Cells(Rows.Count, 20).End(3)(2)
   Next i
    
    With .Columns(20)
     .SpecialCells(xlCellTypeBlanks).Delete
     .RemoveDuplicates Columns:=1, Header:=xlNo
     .Sort Key1:=.Cells(1, 1), Order1:=xlAscending: .Cells(1, 1).Delete
    End With

    For Each c In .Range("T1", .Cells(Rows.Count, 20).End(3))
     ws.Cells(Rows.Count, 1).End(3)(2, 2) = c.Value: x = 0

      For i = 5 To 14 Step 3
       Set k = .Range(.Cells(13, i), .Cells(LR, i)).Find(c.Value, lookat:=xlWhole)
        If Not k Is Nothing Then
          kAd = k.Address
          Do
           ws.Cells(Rows.Count, 1).End(3)(2) = .Cells(k.Row, 1)
           ws.Cells(Rows.Count, 3).End(3)(2) = .Cells(k.Row, 2)
           ws.Cells(Rows.Count, 4).End(3)(2) = k.Offset(, 1).Value
           Set k = .Range(.Cells(13, i), .Cells(LR, i)).FindNext(k)
           x = x + 1
          Loop While Not k Is Nothing And k.Address <> kAd
        End If
      Next i
     ws.Cells(Rows.Count, 4).End(3)(1, 2) = _
      Application.Sum(ws.Cells(Rows.Count, 4).End(3).Offset(-x + 1).Resize(x))
    Next c
    
   .[T:T].Clear
  End With
  Application.ScreenUpdating = True
End Sub

Resumo de Afetações

Enviado: 31 Out 2018 às 20:53
por JCabral
Osvaldo

Do que testei o seu código funciona na perfeição.
Seria possível uma pequena explicação em cada parte do código, é que vou ter que adaptar este código para o caso em que, tenho uma planilha parecida só que em vez de ter 4 colunas com nomes só tenho 2 colunas.

E também o que fazem estas duas linhas de código, já tentei pesquisar mas não encontro nada:
Código: Selecionar todos
ws.Cells(Rows.Count, 1).End(3)(2) = .....
e
Código: Selecionar todos
ws.Cells(Rows.Count, 4).End(3)(1, 2) =.....
Muito obrigado
Jorge Cabral

Re: Resumo de Afetações

Enviado: 31 Out 2018 às 22:29
por osvaldomp
JCabral escreveu: ... tenho uma planilha parecida só que em vez de ter 4 colunas com nomes só tenho 2 colunas.
se E é a primeira das 2 colunas com nomes, então altere esta linha
de For i = 5 To 14 Step 3 para For i = 5 To 8 Step 3


E também o que fazem estas duas linhas de código, já tentei pesquisar mas não encontro nada:
Código: Selecionar todos
ws.Cells(Rows.Count, 1).End(3)(2) = .....
a linha acima equivale a ws.Cells(Rows.Count, 1).End(xlUp).Cells(2,1)
Código: Selecionar todos
ws.Cells(Rows.Count, 4).End(3)(1, 2) =.....
a linha acima equivale a ws.Cells(Rows.Count, 4).End(xlUp).Cells(1, 2)

Resumo de Afetações

Enviado: 31 Out 2018 às 23:25
por JCabral
Osvaldo

Será que podemos dizer que funciona como um Offset?
Ou seja
Código: Selecionar todos
ws.Cells(Rows.Count, 1).End(3)(2) = .....
será equivalente a um Offset(1,0)
e
Código: Selecionar todos
ws.Cells(Rows.Count, 4).End(3)(1, 2) =.....
será equivalente a um Offset(0,1)

Re: Resumo de Afetações

Enviado: 01 Nov 2018 às 08:19
por osvaldomp
Sim, são bem parecidas. São diferentes na base da treferência, pois Offset é base 0 e Cells é base 1.

[G5].Offset(0, 0).Address ===> retorna ===> $G$5
[G5].Cells(0, 0).Address ===> retorna ===> $F$4

[G5].Offset(1, 1).Address ===> retorna ===> $H$6
[G5].Cells(1, 1).Address ===> retorna ===> $G$5

[G5].Offset(-1, -1).Address ===> retorna ===> $F$4
[G5].Cells(-1, -1).Address ===> retorna ===> $E$3

Resumo de Afetações

Enviado: 01 Nov 2018 às 19:41
por JCabral
Osvaldo

Muito obrigado pelo excelente código e pela explicação 5*