Desafio->Verificar se o item que esta sendo adicionado na tabela já existe

Oi Julia,

Entendo sua dificuldade em verificar se um item já existe na tabela antes de adicioná-lo. 🤔

Para resolver isso, você pode usar um loop para percorrer as linhas da planilha "VersaoFinal" e comparar o valor que você quer adicionar com os valores já existentes na coluna que identifica o item.

Se encontrar uma correspondência, você não adiciona o item.

Aqui está um exemplo de como você pode adaptar seu código:

Sub sbManipulaDados()
    Dim rCelula As Range
    Dim lContaLinhaDestino As Long
    Dim sPlanilhaOrigem As String
    Dim linha As Long
    Dim itemExiste As Boolean
    Dim ultimaLinha As Long
    
    lContaLinhaDestino = 2
    sPlanilhaOrigem = ActiveSheet.Name
    
    sbVerificaVersaoFinal
    
    ultimaLinha = Worksheets("VersaoFinal").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets(sPlanilhaOrigem).Select
    
    For Each rCelula In Selection
        If rCelula.Column = 1 Then 'Coluna que identifica o item
            itemExiste = False
            For linha = 2 To ultimaLinha
                If Worksheets("VersaoFinal").Cells(linha, 1).Value = rCelula.Value Then
                    itemExiste = True
                    Exit For
                End If
            Next linha
            
            If Not itemExiste Then
                'Adiciona o item se ele não existir
                If rCelula.Column = 4 Then
                    Worksheets("VersaoFinal").Cells(ultimaLinha + 1, rCelula.Column) = fnAjustaData(rCelula.Value)
                Else
                    Worksheets("VersaoFinal").Cells(ultimaLinha + 1, rCelula.Column) = rCelula.Value
                End If
                ultimaLinha = ultimaLinha + 1
            End If
        End If
    Next rCelula
    
    If ultimaLinha = 1 Then
        sbFormataVersaoFinal
    End If
    
    Sheets("Movimentação").Select
End Sub

Neste exemplo, a variável itemExiste controla se o item já existe. O loop For linha = 2 To ultimaLinha percorre as linhas da planilha "VersaoFinal" e compara o valor da célula atual com os valores da coluna 1.

Se encontrar uma correspondência, itemExiste se torna True e o loop é interrompido.

Se itemExiste for False, o item é adicionado. 😜

Para saber mais: Como usar loops em VBA.

Continue praticando e explorando as possibilidades do VBA! 🧐

Bom dia, Tudo bem ?

Ao tentar fazer seu código ele não puxa os dados de forma correta, acaba sempre puxando os valores somente da Coluna A.

Bom dia, Julia,

Isso é devido à condição If rCelula.Column = 1.

Foi adicionado um loop interno For col = 1 To Selection.Columns.Count que processa todas as colunas da seleção

Mantida a verificação de duplicatas apenas na coluna A

Código modificado:

Sub sbManipulaDados()
    Dim rCelula As Range
    Dim lContaLinhaDestino As Long
    Dim sPlanilhaOrigem As String
    Dim linha As Long
    Dim itemExiste As Boolean
    Dim ultimaLinha As Long
    Dim col As Long
    
    lContaLinhaDestino = 2
    sPlanilhaOrigem = ActiveSheet.Name
    
    sbVerificaVersaoFinal
    
    ultimaLinha = Worksheets("VersaoFinal").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets(sPlanilhaOrigem).Select
    
    For Each rCelula In Selection
        If rCelula.Column = 1 Then 'Verifica duplicatas apenas na coluna A
            itemExiste = False
            For linha = 2 To ultimaLinha
                If Worksheets("VersaoFinal").Cells(linha, 1).Value = rCelula.Value Then
                    itemExiste = True
                    Exit For
                End If
            Next linha
            
            If Not itemExiste Then
                'Adiciona todas as colunas da linha quando encontra um novo item
                For col = 1 To Selection.Columns.Count
                    If col = 4 Then 'Verifica se é a coluna de data
                        Worksheets("VersaoFinal").Cells(ultimaLinha + 1, col) = fnAjustaData(Selection.Cells(rCelula.Row, col).Value)
                    Else
                        Worksheets("VersaoFinal").Cells(ultimaLinha + 1, col) = Selection.Cells(rCelula.Row, col).Value
                    End If
                Next col
                ultimaLinha = ultimaLinha + 1
            End If
        End If
    Next rCelula
    
    If ultimaLinha = 1 Then
        sbFormataVersaoFinal
    End If
    
    Sheets("Movimentação").Select
End Sub

Bom dia Luis, Tudo bem ?

Sua lógica de adicionar itemExiste = True e itemExiste = False me ajudou a desenvolver o programa! No caso, eu precisava que ele verificasse da coluna A até a coluna D, mas como, quando o código roda de uma planilha para outra, ocorre a formatação do campo de data, acabei fazendo com que o código realizasse a verificação da coluna A até a coluna C.

Sheet Movimentação: Sheet VersaoFinal:

Segue o código para caso alguem tenha alguma dúvida ao executar esse exercício:

Sub sbManipulaDados()
    'Declaração de variável como célula
    Dim rCelula            As Range
    Dim rCelula1           As Range
    Dim lContaLinhaDestino As Long
    Dim sPlanilhaOrigem    As String
    Dim linha              As Integer
    Dim ultimaLinha        As Long
    Dim itemExiste         As Boolean
    Dim linha1             As Integer

    'Inicializa a variável
    lContaLinhaDestino = 2
    sPlanilhaOrigem = ActiveSheet.Name
    
    'Verifica se ja existe ou não a planilha versão final
    sbVerificaVersaoFinal
    
    ultimaLinha = Worksheets("VersaoFinal").Cells(Rows.Count, 1).End(xlUp).Row
    
    linha = 1

    'Faz a contagem de linha da Sheet Versão Final
    Do While Worksheets("VersaoFinal").Cells(linha, 1).Value <> vbNullString
        linha = linha + 1
    Loop
    
    If linha = 2 Then
        'Selecionar a planilha que contém a origem dos dados
        Sheets(sPlanilhaOrigem).Select
        'Para cada celula na Seleção,estrutura de repetição do tipo For Each
        For Each rCelula In Selection
            
            If rCelula.Column = 4 Then
                Sheets("VersaoFinal").Cells(lContaLinhaDestino, rCelula.Column) = fnAjustaData(rCelula.Value)
                'Incrementa para andar uma linha
                lContaLinhaDestino = lContaLinhaDestino + 1
            Else
                Sheets("VersaoFinal").Cells(lContaLinhaDestino, rCelula.Column) = rCelula
            End If

        Next
    Else
    
        'Selecionar a planilha que contém a origem dos dados
        Sheets(sPlanilhaOrigem).Select
        itemExiste = False
        
        ' Verifica se há múltiplas seleções
        For Each rCelula In Selection
            itemExiste = False
            If rCelula.Column = 1 Then
                ' Atualiza rCelula1 com o valor da célula atual
                Set rCelula1 = rCelula
            End If
            
            ' Verifica duplicatas na planilha "VersaoFinal"
            For linha = 2 To ultimaLinha
                If Trim(Worksheets("VersaoFinal").Cells(linha, 1).Value) = Trim(rCelula1.Value) And _
                   Trim(Worksheets("VersaoFinal").Cells(linha, 2).Value) = Trim(rCelula1.Offset(0, 1).Value) And _
                   Trim(Worksheets("VersaoFinal").Cells(linha, 3).Value) = Trim(rCelula1.Offset(0, 2).Value) Then
                    itemExiste = True
                    Exit For
            End If
        Next linha
        
        ' Executa ações caso duplicata não seja encontrada
        If itemExiste = False Then
   
                ' Verifica se a célula está na coluna 4 (Coluna D) para realizar um ajuste especial
                If rCelula.Column = 4 Then
                    Worksheets("VersaoFinal").Cells(linha, rCelula.Column).Value = fnAjustaData(rCelula.Value)
                    ultimaLinha = ultimaLinha + 1
                Else
                    Worksheets("VersaoFinal").Cells(linha, rCelula.Column).Value = rCelula.Value
                End If
        End If

         Next rCelula
    End If

    If linha = 2 Then
        'Sub usada para chamar a versão final que é responsável por formatar a tabela na planilha VersaoFinal
        sbFormataVersaoFinal
        Sheets("Movimentação").Select
    Else
       Sheets("Movimentação").Select
    End If
    

    
End Sub

Obrigada pela ajuda!