locked
Macro para comparar duas tabelas em arquivos distintos e mostrar o que esta diferente

    Question

  •  

    Estou fazendo uma macro para comparar dois arquivos,  no caso Pasta1 e Pasta2 e gostaria de saber como posso mostrar o que esta  diferente, visto que o arquivo tem 6545 linhas.

    Alguem poderia me ajudar ou sujerir alguma macro melhor?

    De repente no lugar do MsgBox colocar para gerar uma nova planilha ou algo do gênero.

    Obrigado.

     

    Linha de comando:

     

    Sub Comparacao()
      Dim Coluna As Long
      Dim Linha As Long
      Dim Celula As String
      Dim Nomes(260) As String
      Dim UltimaColuna As String
      Dim Ultima_Coluna As Long
      Dim UltimaLinha As Long
      Dim NomeArquivo As String
      Dim NomePlanilha As String

     

      UltimaColuna = "g"
      UltimaLinha = 6545
      NomeArquivo = "Pasta2.xls"
      NomePlanilha = "Plan1"
     
      Application.ScreenUpdating = False
      UltimaColuna = Format(UltimaColuna, ">")
      If Len(UltimaColuna) = 2 Then
      Ultima_Coluna = (Asc(Left(UltimaColuna, 1)) - 64) * 26 + (Asc(Right(UltimaColuna, 1)) - 64)
      Else
      Ultima_Coluna = Asc(Right(UltimaColuna, 1)) - 64
      End If
      For Linha = 1 To UltimaLinha
      For Coluna = 1 To Ultima_Coluna
      Cells(Linha, Coluna).Select
      Celula = Cells(Linha, Coluna)
      ActiveCell.Formula = "=[" & NomeArquivo & "]" & NomePlanilha & "!" & Cells(Linha, Coluna).Address 'Nomes(Coluna) & CStr(Linha)
      If Celula <> Cells(Linha, Coluna) Then
      'aqui vem a rotina de criação do log
      MsgBox "Igual"
      Else
      MsgBox "Diferente"
      End If
      Cells(Linha, Coluna) = Celula
      Next Coluna
      Next Linha
      Application.ScreenUpdating = True
    End Sub

    Thursday, January 31, 2008 12:52 PM

Answers

  • Segue um draft inicial.

    Na minha máquina roda em alguns segundos, mas podemos otimizar o código.

    Execute-o e vamos fazendo os ajustes que melhor se adequem ao teu caso.

    Code Snippet

     

    Sub Comparacao()
      Dim Coluna As Long
      Dim Linha As Long
      Dim Celula As String
      Dim Nomes(260) As String
      Dim UltimaColuna As String
      Dim Ultima_Coluna As Long
      Dim UltimaLinha As Long
      Dim NomeArquivo As String
      Dim NomePlanilha As String
      Dim Pasta1 As Worksheet
      Dim Pasta2 As Worksheet
      Dim Celula1 As Variant
      Dim Celula2 As Variant
      Dim Compara(1 To 6545, 1 To 7)


      Set Pasta2 = Workbooks("Pasta2.xlsm").Sheets("Plan1")
      Set Pasta1 = Workbooks("Pasta1.xlsm").Sheets("Plan1")
     
      UltimaColuna = "g"
      UltimaLinha = 6545
     
      'Interromper a exibição de mudanças de tela
      Application.ScreenUpdating = False
       
        'Transformação da última coluna de letra em número
        UltimaColuna = Format(UltimaColuna, ">")
        If Len(UltimaColuna) = 2 Then
        Ultima_Coluna = (Asc(Left(UltimaColuna, 1)) - 64) * 26 + (Asc(Right(UltimaColuna, 1)) - 64)
        Else
        Ultima_Coluna = Asc(Right(UltimaColuna, 1)) - 64
        End If
     
      'Loop através das células do intervalo de comparação
            For Linha = 1 To UltimaLinha
                For Coluna = 1 To Ultima_Coluna
               
                Celula1 = Pasta1.Cells(Linha, Coluna)
                Celula2 = Pasta2.Cells(Linha, Coluna)
                   
                    'Comparação das células das duas pastas
                    If Celula1 <> Celula2 Then
                    Compara(Linha, Coluna) = "Diferente"
                    Else
                    Compara(Linha, Coluna) = "Igual"
                    End If
               
                Next Coluna
            Next Linha
     
      Workbooks.Add
     
            For Linha = 1 To UltimaLinha
                For Coluna = 1 To Ultima_Coluna
                Cells(Linha, Coluna) = Compara(Linha, Coluna)
                Next Coluna
            Next Linha
     
      'Restaurar a exibição de mudanças de tela
      Application.ScreenUpdating = True
     
    End Sub

     

     

    []s

     

    Thursday, January 31, 2008 1:26 PM
  •  Ricardo Gomes wrote:

    Deu, consegui, era só problemas com a declaração das variaveis.

    Muito obrigado Adilson!

     

    Abração

     

    Às ordens.

    A velocidade ficou satisfatória?

    Podemos tentar otimizar e ganhar tempo de execução.

    Caso esteja ok pra vc, por favor, marque o tópico como respondido, para mantermos as regras do fórum.

    []s

     

    Thursday, January 31, 2008 7:01 PM

All replies

  • Segue um draft inicial.

    Na minha máquina roda em alguns segundos, mas podemos otimizar o código.

    Execute-o e vamos fazendo os ajustes que melhor se adequem ao teu caso.

    Code Snippet

     

    Sub Comparacao()
      Dim Coluna As Long
      Dim Linha As Long
      Dim Celula As String
      Dim Nomes(260) As String
      Dim UltimaColuna As String
      Dim Ultima_Coluna As Long
      Dim UltimaLinha As Long
      Dim NomeArquivo As String
      Dim NomePlanilha As String
      Dim Pasta1 As Worksheet
      Dim Pasta2 As Worksheet
      Dim Celula1 As Variant
      Dim Celula2 As Variant
      Dim Compara(1 To 6545, 1 To 7)


      Set Pasta2 = Workbooks("Pasta2.xlsm").Sheets("Plan1")
      Set Pasta1 = Workbooks("Pasta1.xlsm").Sheets("Plan1")
     
      UltimaColuna = "g"
      UltimaLinha = 6545
     
      'Interromper a exibição de mudanças de tela
      Application.ScreenUpdating = False
       
        'Transformação da última coluna de letra em número
        UltimaColuna = Format(UltimaColuna, ">")
        If Len(UltimaColuna) = 2 Then
        Ultima_Coluna = (Asc(Left(UltimaColuna, 1)) - 64) * 26 + (Asc(Right(UltimaColuna, 1)) - 64)
        Else
        Ultima_Coluna = Asc(Right(UltimaColuna, 1)) - 64
        End If
     
      'Loop através das células do intervalo de comparação
            For Linha = 1 To UltimaLinha
                For Coluna = 1 To Ultima_Coluna
               
                Celula1 = Pasta1.Cells(Linha, Coluna)
                Celula2 = Pasta2.Cells(Linha, Coluna)
                   
                    'Comparação das células das duas pastas
                    If Celula1 <> Celula2 Then
                    Compara(Linha, Coluna) = "Diferente"
                    Else
                    Compara(Linha, Coluna) = "Igual"
                    End If
               
                Next Coluna
            Next Linha
     
      Workbooks.Add
     
            For Linha = 1 To UltimaLinha
                For Coluna = 1 To Ultima_Coluna
                Cells(Linha, Coluna) = Compara(Linha, Coluna)
                Next Coluna
            Next Linha
     
      'Restaurar a exibição de mudanças de tela
      Application.ScreenUpdating = True
     
    End Sub

     

     

    []s

     

    Thursday, January 31, 2008 1:26 PM
  • Boa tarde,

    Tipo, tentei executar, deu 1 bug e consegui resolver, no entanto deu agora um "erro de tempo de execução '13' - Tipos incompativeis"

    No momento que depurei, ele mostrou a linha da comparação:

     

    Sub Comparacao()
      Dim Coluna As Long
      Dim Linha As Long
      Dim Celula As String
      Dim Nomes(260) As String
      Dim UltimaColuna As String
      Dim Ultima_Coluna As Long
      Dim UltimaLinha As Long
      Dim NomeArquivo As String
      Dim NomePlanilha As String
      Dim Pasta1 As Worksheet
      Dim Pasta2 As Worksheet
      Dim Celula1 As Variant
      Dim Celula2 As Variant
      Dim Compara(1 To 6000, 1 To 7)


      Set Pasta2 = Workbooks("Pasta2.xls").Sheets("Plan1")
      Set Pasta1 = Workbooks("Pasta1.xls").Sheets("Plan1")
     
      UltimaColuna = "g"
      UltimaLinha = 6000
     
      'Interromper a exibição de mudanças de tela
      Application.ScreenUpdating = False
       
        'Transformação da última coluna de letra em número
        UltimaColuna = Format(UltimaColuna, ">")
        If Len(UltimaColuna) = 2 Then
        Ultima_Coluna = (Asc(Left(UltimaColuna, 1)) - 64) * 26 + (Asc(Right(UltimaColuna, 1)) - 64)
        Else
        Ultima_Coluna = Asc(Right(UltimaColuna, 1)) - 64
        End If
     
      'Loop através das células do intervalo de comparação
            For Linha = 1 To UltimaLinha
                For Coluna = 1 To Ultima_Coluna
               
                Celula1 = Pasta1.Cells(Linha, Coluna)
                Celula2 = Pasta2.Cells(Linha, Coluna)
                   
                    'Comparação das células das duas pastas
                    If Celula1 <> Celula2 Then     -> Erro de tempo de execução '13' - Tipos incompativeis??
                    Compara(Linha, Coluna) = "Diferente"
                    Else
                    Compara(Linha, Coluna) = "Igual"
                    End If
               
                Next Coluna
            Next Linha
     
      Workbooks.Add
     
            For Linha = 1 To UltimaLinha
                For Coluna = 1 To Ultima_Coluna
                Cells(Linha, Coluna) = Compara(Linha, Coluna)
                Next Coluna
            Next Linha
     
      'Restaurar a exibição de mudanças de tela
      Application.ScreenUpdating = True
     
    End Sub

     

     

    Obrigado

    abraço!

    Thursday, January 31, 2008 3:55 PM
  • Deu, consegui, era só problemas com a declaração das variaveis.

    Muito obrigado Adilson!

     

    Abração

    Thursday, January 31, 2008 4:25 PM
  •  Ricardo Gomes wrote:

    Deu, consegui, era só problemas com a declaração das variaveis.

    Muito obrigado Adilson!

     

    Abração

     

    Às ordens.

    A velocidade ficou satisfatória?

    Podemos tentar otimizar e ganhar tempo de execução.

    Caso esteja ok pra vc, por favor, marque o tópico como respondido, para mantermos as regras do fórum.

    []s

     

    Thursday, January 31, 2008 7:01 PM