Notifications
Clear all

Formula com 2 procs sem perder o primeiro valor

23 Posts
4 Usuários
0 Reactions
4,204 Visualizações
(@ajhottz)
Posts: 64
Trusted Member
Topic starter
 

Bom dia pessoal,
Estou com um problema aqui que para mim parece ser impossível de se resolver.
Vamos a situação, primeiro preciso extrair informações do sistema como na Plan1. Até ai tranquilo, o problema que tenho que preencher a planilha de orçamento com eles. E como as contas variam, não posso simplesmente linkar as células, preciso de um proc para encontrar a conta correta, e outro pra localizar o mês correto. Resolvido esse problema ( que não consigo resolver) Gostaria de saber um jeito de trocar as informações para o mes seguinte nessa Plan1, sem zerar as informações que eu havia obtido antes, não consegui me explicar direito, espero q com o exemplo entendam.

Obrigado da atenção
Att,
AjHottz

 
Postado : 06/05/2014 7:49 am
(@ajhottz)
Posts: 64
Trusted Member
Topic starter
 

Fiz isso, porém o erro continua, irei anexar a planilha com tudo no formato de número, da uma olhada por favor... To com vergonha já, sei fazer nada

 
Postado : 08/05/2014 7:55 am
(@gtsalikis)
Posts: 2373
Noble Member
 

AjHottz,

Agora que os CO estão todos corretos, eu vi que esqueci de desconsiderar a última linha, que tem o total (E não tinha testado exatamente porque tinha que corrigir os CO).

segue o código já com a alteração:

Option Explicit

Sub Transporta_GT()

Application.ScreenUpdating = False

Dim ws(2)       As Worksheet
Dim UL(2)       As Integer 'Última Linha
Dim i(2)        As Integer

Dim CO          As Long
Dim Linha       As Integer
Dim Coluna(3)   As Integer

Dim O           As Integer 'O = Origem
Dim D           As Integer 'D = Destino

O = 0
D = 1

Set ws(O) = Sheets("Plan1")
Set ws(D) = Sheets("Plan2")

UL(O) = ws(O).Cells(Rows.Count, "B").End(xlUp).Row
UL(D) = ws(D).Cells(Rows.Count, "B").End(xlUp).Row

Coluna(0) = ws(O).Range("B2").Value * 2
 Coluna(1) = Coluna(0) + 2
 Coluna(2) = Coluna(0) + 3

For i(O) = 4 To UL(O) - 1
    CO = ws(O).Cells(i(O), "B").Value
    i(D) = Application.Match(CO, ws(D).Range("B1:B" & UL(D)), 0)
    ws(D).Cells(i(D), Coluna(1)).Value = ws(O).Cells(i(O), "D").Value
    ws(D).Cells(i(D), Coluna(2)).Value = ws(O).Cells(i(O), "E").Value
Next i(O)

Application.ScreenUpdating = True

End Sub

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 08/05/2014 10:08 am
(@ajhottz)
Posts: 64
Trusted Member
Topic starter
 

Muito obrigado mesmo, era exatamente isso que eu queria... e parabéns pelo seu conhecimento

 
Postado : 08/05/2014 10:42 am
(@ajhottz)
Posts: 64
Trusted Member
Topic starter
 

Só preciso de mais uma ajuda... hahaha
Dentro da planilha original existem varias sheets com Centros de custos diferentes, preciso fazer uma sheet pra cada uma ou consigo fazer uma especie de proc pra procurar a sheet correta (PS: as sheets tem os nomes dos CC, ex: 71101, 72101 etc)

 
Postado : 08/05/2014 11:15 am
(@gtsalikis)
Posts: 2373
Noble Member
 

Creio que daria pra configurar pra ela procurar automaticamente.

Mas vc teria que enviar um modelo da planilha original, pq eu não estou conseguindo visualizar isso. No teu modelo, a Plan 1 não tem o centro de custo. Assim, não sei como o código vai descobrir a qual centro de custo cada CO se refere.

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 08/05/2014 3:09 pm
benzadeus
(@benzadeus)
Posts: 78
Trusted Member
 
Public Sub pMain()
  Dim Origem As Excel.Worksheet
  Dim Destino As Excel.Worksheet
  Dim RowOrigem As Long
  Dim RowDestino As Long
  Dim ColDestino As Long
  
  With ThisWorkbook
    Set Origem = .Worksheets("Plan1")
    Set Destino = .Worksheets("Plan2")
  End With
    
  For RowOrigem = 4 To Origem.Cells(Origem.Rows.Count, "B").End(xlUp).Row
    RowDestino = pMatch(Origem.Cells(RowOrigem, "B").Value2, Destino.Columns("B"))
    If RowDestino > 0 Then
      ColDestino = pMatch(Origem.Range("C2").Value2, Destino.Rows(10))
      If ColDestino > 0 Then
        Destino.Cells(RowDestino, ColDestino).Value2 = Origem.Cells(RowOrigem, "B").Value2
      Else
        'Mês não encontrado no Destino.
      End If
    Else
      'CO não encontrado no Destino.
    End If
  Next RowOrigem
End Sub

Private Function pMatch(varValue As Variant, varArray As Variant) As Long
  On Error Resume Next
  pMatch = WorksheetFunction.Match(CDbl(varValue), varArray, 0)
  If pMatch = 0 Then pMatch = WorksheetFunction.Match(CStr(varValue), varArray, 0)
End Function

Felipe Costa Gualberto
Microsoft Excel MVP
http://www.ambienteoffice.com.br

 
Postado : 08/05/2014 5:36 pm
(@ajhottz)
Posts: 64
Trusted Member
Topic starter
 

gtsalikis

Segue planilha de exemplo conforme solicitado e Benzadeus, sou um lixo em vba, pode me explicar esse código ?

Att,
AjHottz

 
Postado : 12/05/2014 6:21 am
(@gtsalikis)
Posts: 2373
Noble Member
 

Veja agora.

Abs

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 12/05/2014 3:58 pm
Página 2 / 2