Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Adaptar Relatório -...
 
Notifications
Clear all

Adaptar Relatório - Copiar Informação

 
2024 - VBA & Macros
4 Posts
3 Usuários
0 Reactions
708 Visualizações
RSS
 mateusdr
(@mateusdr)
Posts: 0
New Member
Topic starter
 

Olá Companheiros,

Bom dia!

Tenho a seguinte situação:

O software de minha empresa fornece um relatório onde mostra todas as medicações preparadas para pacientes de determinado médico em determinado período.

No entanto, para poder utilizar a informação em outra planilha, necessitaria que fosse preenchido o Código CRM do médico na mesma linha de cada medicação preparada. (para poder usar um somar.se/cont.se, por médico futuramente)

Acontece que, a informação do CRM aparece apenas na primeira linha da listagem e a cada listagem, o número de linhas é variável.

Ao baixar a planilha, ficará mais simples de entender.

Fiz uma planilha mostrando o relatório original, e na dois como eu gostaria que ele ficasse após executar a macro.

Será que alguém sabe uma solução para isso?

Obrigado desde já

 
Postado : 23/10/2015 1:49 am
 edilsonfl
(@edilsonfl)
Posts: 227
Estimable Member
 

Olá mateusdr,

Fiz uma solução com fórmulas e outra com VBA.

A opção com fórmulas não é 100% igual ao que vc esperava ( mas traz a informação desejada em outra coluna), é mas fácil de manter/alterar por usuários iniciantes.

A solução com VBA (macro) faz exatamente o que vc deseja, conhecendo o básico de VBA dá até pra fazer adaptações.

Modelo - Edilson .zip
 
Postado : 24/10/2015 10:21 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Tente..

Sub AleVBA_17824()
With Columns(2)
  Set c = .Find("DATA ENTRADA", LookIn:=xlValues, lookat:=xlPart, searchformat:=False)
  If Not c Is Nothing Then
    firstAddress = c.Address
    Do
      Range(c.Offset(1, -1), Cells(c.End(xlDown).Row, 1)).FormulaR1C1 = "=R" & c.Row - 1 & "C2"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
End With
End Sub

Att

 
Postado : 26/10/2015 5:15 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Tente..

Sub AleVBA_17824()
With Columns(2)
  Set c = .Find("DATA ENTRADA", LookIn:=xlValues, lookat:=xlPart, searchformat:=False)
  If Not c Is Nothing Then
    firstAddress = c.Address
    Do
      Range(c.Offset(1, -1), Cells(c.End(xlDown).Row, 1)).FormulaR1C1 = "=R" & c.Row - 1 & "C2"
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
End With
End Sub

Att

 
Postado : 26/10/2015 5:15 am
Forum Jump:
  Tópico Anterior
Próximo Tópico