Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
Avatar do usuário
Por JCabral
Avatar
#38139
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
Você não está autorizado a ver ou baixar esse anexo.
Por osvaldomp
#38239
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
Avatar do usuário
Por JCabral
Avatar
#38246
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
Por osvaldomp
#38247
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)
Avatar do usuário
Por JCabral
Avatar
#38249
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)
Por osvaldomp
#38252
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
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord