MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Importação evitando duplicidades Excel VBA

    janettepires
    janettepires
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 126
    Registrado : 14/03/2013

    Importação evitando duplicidades Excel VBA Empty Importação evitando duplicidades Excel VBA

    Mensagem  janettepires 21/8/2020, 21:09

    Boa tarde!

    Pessoal,

    É seguinte eu tenho duas planilhas para controle de tarefas, uma utilizada pelo Gestor (Consolidada) e outra pelo colaborador (cada um tem a sua). A idéia é o Gestor carregar as informações da planilha dos colaboradores diariamente para a planilha Consolidada e  se um registro já existir apenas alterar os campos e não importar para evitar duplicidade.
    Segue o meu código, nesse caso, está carregando tudo sem validação, sem filtros.

    Código:
    Public Sub Consolidar()

    Dim lin01, lin02, lin03 As Integer
    Dim ArqColobaborador As String

    Application.ScreenUpdating = False


    lin01 = 3
    lin03 = 2
    Do Until Sheets("Painel").Cells(lin01, 3).Value = Empty
       Arqcolaborador = Sheets("Painel").Cells(lin01, 3).Value
       Workbooks.Open (ThisWorkbook.Path & "\Colaboradores\" & Arqcolaborador & ".xlsx")
       lin02 = 2

       Do Until Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 1).Value = Empty
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 1).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 1).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 2).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 2).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 3).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 3).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 4).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 4).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 5).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 5).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 6).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 6).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 7).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 7).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 8).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 8).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 9).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 9).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 10).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 10).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 11).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 11).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 12).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 12).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 13).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 13).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 14).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 14).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 15).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 15).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 16).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 16).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 17).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 17).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 18).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 18).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 19).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 19).Value
           ThisWorkbook.Sheets("Demandas").Cells(lin03, 20).Value = Workbooks(Arqcolaborador).Sheets(1).Cells(lin02, 20).Value
           
          lin03 = lin03 + 1
          lin02 = lin02 + 1
         
       Loop
       
       
       Workbooks(Arqcolaborador).Close (False)
       lin01 = lin01 + 1

    Loop
    End Sub

       
    Se puderem me ajudar, eu agradeço

    bjs
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1172
    Registrado : 13/12/2016

    Importação evitando duplicidades Excel VBA Empty Re: Importação evitando duplicidades Excel VBA

    Mensagem  Alexandre Fim 21/8/2020, 22:10

    Janette boa tarde,

    Apesar do fórum ser relacionado às duvida do Access, vou tentar te ajudar.

    Provavelmente, é necessário fazer um PROCV (Vlookup) na planilha do Consolidado e, se achar os dados da planilha do colaborador, edita a linha, senão adiciona a linha.

    Segue um exemplo em VBA:

    Código:


    Sub vbaProcvTodosValoresComErro()
     
        ultLinha = Cells(Cells.Rows.Count, 1).End(xlUp).Row
        Dim codigo_produto As Integer
     
       
        For inicio = 2 To ultLinha
           
            codigo_produto = Cells(inicio, 1).Value
     
            resultado_procv = Application.VLookup(codigo_produto, Workbooks("Pasta1").Sheets("Planilha2").Range("A:B"), 2, False)
            If IsError(resultado_procv) Then
                Cells(inicio, 3).Value = "valor não encontrado"
            Else
                Cells(inicio, 3).Value = resultado_procv
            End If
            Next inicio
     
    End Sub




    Fonte: excelpraontem.com.br/procv-vba/

    Espero ter ajudado


    .................................................................................
    - Procure sempre anexar seu projeto para análise do problema/dúvida.
    - Ao copiar/colar um código VBA, procure entender seu funcionamento.
    - Se o problema foi resolvido, não se esqueça de marcar o tópico como RESOLVIDO.
    janettepires
    janettepires
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 126
    Registrado : 14/03/2013

    Importação evitando duplicidades Excel VBA Empty Re: Importação evitando duplicidades Excel VBA

    Mensagem  janettepires 21/8/2020, 22:40

    Oi Alexandre,

    Obrigada pela resposta!

    Mas como eu adapto esse código ao meu?

    bjs
    avatar
    jrm
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 124
    Registrado : 10/08/2012

    Importação evitando duplicidades Excel VBA Empty Re: Importação evitando duplicidades Excel VBA

    Mensagem  jrm 28/8/2020, 17:12

    ola

    Parece-me que o mais fácil é você copiar todo o arquivo do colaborador para o arquivo consolidado e depois remover as linhas duplicadas.
    cria um botão na planilha Consolidado com o nome atualizar e atribui ao mesmo o seguinte código(macro e função):

    Código:
    Function rngUsado(ws As Worksheet) As Range
    'determina o nª de linhas da Folha
     With ws
       Set rngUsado = .Range("A1:" & _
        .UsedRange(.UsedRange.Cells.Count).Address)
     End With
    End Function

    Public Sub copiar()

        Dim wb As Workbook
       Dim wsTodos As Worksheet
       

    Application.DisplayAlerts = False
         
               Set wb = Workbooks.Open (ThisWorkbook.Path & "\Colaboradores\" & Arqcolaborador & ".xlsx")
         
           rngUsado(wb.Sheets(1)).Copy Destination:=wsTodos.Range("A" & _
          rngUsado(wsTodos).Rows.Count + 1)
         wb.Close
     
    Application.DisplayAlerts = True

     'MsgBox "Actualização  concluída com sucesso!!! "
    End Sub

    Depois precisa criar uma nova macro para remover os duplicados para isso preciso saber qual ou quais os campos(celulas) que são sempre iguais em cada linha (pode gravar com o gravador automatico)
    se o nome da macro for (removeduplicados) então no final da macro acima  antes do Msgbox coloca mais uma linha com o seguinte:
    call removeduplicados.

    se não conseguir criar a macro para remover os duplicados "apite".

    se tiver varios colaboradores vai ter de fazer este processo tantas vezes quanto o nª de colaboradores pode depois usar um ciclo For

      Data/hora atual: 28/2/2021, 13:54