Notifications
Clear all

Procurar Mudança de Valor e Colar em outra guia.

5 Posts
2 Usuários
0 Reactions
1,113 Visualizações
(@brunoafs)
Posts: 195
Reputable Member
Topic starter
 

Boa tarde pessoal,

Tenho uma planilha com mais de 10.000 linhas.

Onde existem várias datas, com diversos clientes e valores.

Os dados estão organizados por Contrato > Nome > Data

Preciso que a macro procure pelo variavel 'Contrato' ou 'nome' e me retorne:

1º - A linha inteira da primeira data de registro do cliente

2º - Retornar a linha inteira quando a coluna G (Valor) houver alteração (pode aumentar ou diminuir).

Segue anexo da planilha com a BASE simulada pois são dados confidenciais e um Exemplo de três clientes de como tem que ficar.

 
Postado : 11/03/2015 11:42 am
(@brunoafs)
Posts: 195
Reputable Member
Topic starter
 

Alguem pode me ajudar com a rotina For Next ?

Sou iniciante em VBA mas dá pra enrolar...

Fiz 4 For Next para atender minha necessidade...

Porém quando o For de numero 4 ele volta para o 3
Gostaria que do 4 fosse para o primeiro.

Onde tem A + 1 e A + 2 eu vou mudar para procurar a ultima linha vazia.
Só estava testando o código antes

Sub Teste()

Dim A As Double
Dim B As Double
Dim C As Double
Dim D As Double

    For A = 2 To 1000
    
    If Plan1.Cells(A, 10) = "" Then Exit For
      Contrato = Plan1.Cells(A, 10)
      
        For B = 2 To 20000
        
        If Plan1.Cells(B, 2) = "" Then Exit For
        If Plan1.Cells(B, 2) = Contrato Then
        
            Data1 = Plan1.Cells(B, 8)
            Valor1 = Plan1.Cells(B, 7)
            Plan1.Cells(A, 12) = Contrato
            Plan1.Cells(A, 13) = Valor1
            Plan1.Cells(A, 14) = Data1
                
            For C = 2 To 20000
            
            If Plan1.Cells(C, 7) = "" Then Exit For
            If Plan1.Cells(C, 7) <> Valor1 Then
            
                Valor2 = Plan1.Cells(C, 7)
                Data2 = Plan1.Cells(C, 8)
                Plan1.Cells(A + 1, 12) = Contrato
                Plan1.Cells(A + 1, 13) = Valor2
                Plan1.Cells(A + 1, 14) = Data2
            
                    For D = 2 To 20000
                    
                    If Plan1.Cells(D, 7) = "" Then Exit For
                    If Plan1.Cells(D, 7) <> Valor1 And Plan1.Cells(D, 7) <> Valor2 And Plan1.Cells(D, 2) = Contrato Then
            
                        Valor3 = Plan1.Cells(D, 7)
                        Data3 = Plan1.Cells(D, 8)
                        Plan1.Cells(A + 2, 12) = Contrato
                        Plan1.Cells(A + 2, 13) = Valor3
                        Plan1.Cells(A + 2, 14) = Data3
                    
                    End If
                    Next D
                    
            End If
            
            Next C
    
        End If
        
        Next B
      
    Next A

End Sub
 
Postado : 11/03/2015 5:46 pm
(@brunoafs)
Posts: 195
Reputable Member
Topic starter
 

Consegui desse jeito, mas possivelmente deve ter um código mais simplificado.

O que vale é o esforço rsrs

Sub Teste()

Application.ScreenUpdating = False

Dim A As Double, B As Double, C As Double, D As Double

A = 2

Do While Plan1.Cells(A, 13) <> ""
    Contrato = Plan1.Cells(A, 13)
    
    For B = 2 To 20000

    If Plan1.Cells(B, 4) = "" Then Exit For
    If Plan1.Cells(B, 4) = Contrato And Plan1.Cells(B, 10) <> 0 Then
        
        UltimaLinha = Range("O1048576").End(xlUp).Offset(1, 0).Row
        Empreendimento1 = Plan1.Cells(B, 3)
        Cliente1 = Plan1.Cells(B, 5)
        Data1 = Plan1.Cells(B, 11)
        Valor1 = Plan1.Cells(B, 10)
        Plan1.Cells(UltimaLinha, 15) = Empreendimento1
        Plan1.Cells(UltimaLinha, 16) = Contrato
        Plan1.Cells(UltimaLinha, 17) = Cliente1
        Plan1.Cells(UltimaLinha, 18) = Valor1
        Plan1.Cells(UltimaLinha, 19) = Data1
    Exit For
    End If
    Next
    
        For C = 2 To 20000
    
        If Plan1.Cells(C, 4) = "" Then Exit For
        If Plan1.Cells(C, 4) = Contrato And Plan1.Cells(C, 10) <> Valor1 And Plan1.Cells(C, 11) > Data1 Then
        
            UltimaLinha = Range("O1048576").End(xlUp).Offset(1, 0).Row
            Empreendimento2 = Plan1.Cells(C, 3)
            Cliente2 = Plan1.Cells(C, 5)
            Data2 = Plan1.Cells(C, 11)
            Valor2 = Plan1.Cells(C, 10)
            Plan1.Cells(UltimaLinha, 15) = Empreendimento2
            Plan1.Cells(UltimaLinha, 16) = Contrato
            Plan1.Cells(UltimaLinha, 17) = Cliente2
            Plan1.Cells(UltimaLinha, 18) = Valor2
            Plan1.Cells(UltimaLinha, 19) = Data2
        Exit For
        End If
        Next
        
            For D = 2 To 20000
    
            If Plan1.Cells(D, 4) = "" Then Exit For
            If Plan1.Cells(D, 4) = Contrato And Plan1.Cells(D, 10) <> Valor1 And Plan1.Cells(C, 11) > Data1 Then
            If Plan1.Cells(D, 4) = Contrato And Plan1.Cells(D, 10) <> Valor2 And Plan1.Cells(C, 11) > Data2 Then
        
                UltimaLinha = Range("O1048576").End(xlUp).Offset(1, 0).Row
                Empreendimento3 = Plan1.Cells(D, 3)
                Cliente3 = Plan1.Cells(D, 5)
                Data3 = Plan1.Cells(D, 11)
                Valor3 = Plan1.Cells(D, 10)
                Plan1.Cells(UltimaLinha, 15) = Empreendimento3
                Plan1.Cells(UltimaLinha, 16) = Contrato
                Plan1.Cells(UltimaLinha, 17) = Cliente3
                Plan1.Cells(UltimaLinha, 18) = Valor3
                Plan1.Cells(UltimaLinha, 19) = Data3
            Exit For
            End If
            End If
            Next


A = A + 1
Loop

Application.ScreenUpdating = True

End Sub
 
Postado : 11/03/2015 9:22 pm
(@djanes)
Posts: 13
Active Member
 

Favor, considere este arquivo...

 
Postado : 13/03/2015 6:42 pm
(@brunoafs)
Posts: 195
Reputable Member
Topic starter
 

Tão simples... Valeu DJANES

Vou fazer umas adaptações para ficar do jeito certinho.

Obrigado.

 
Postado : 13/03/2015 10:25 pm