Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Juntar planilhas / copiar e colar com critérios

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
CH7
Colaborador
Colaborador
Mensagens: 12
Registrado em: Qui Jan 31, 2019 12:13 pm

Juntar planilhas / copiar e colar com critérios

Mensagem por CH7 »

Bom dia, estou com algumas dificuldades de juntar duas planilhas. Essas planilhas tem dados iguais, uma planilha se chama VM (a que está faltando alguns dados) e a outra WL (a que tem todos os dados), mas esses dados iguais não estão em mesmas ordens, então o vba teria que filtrar por 3 critérios, no exemplo vão ser Marcas, Pessoas e id, não daria somente para filtrar por um critério só pois os dados que vem são muito parecidos, então precisa dos 3 critérios.

Então seria o seguinte, achar os critérios de uma planilha para outra e copiar e colar as informações que estão faltando na planilha VM, mandarei um zip com a planilha para um melhor entendimento.

Obrigado pela atenção. :D
Anexos
Teste.zip
(8.1 KiB) Baixado 183 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


srobles
Jedi
Jedi
Mensagens: 805
Registrado em: Qua Mai 06, 2015 7:39 pm

Re: Juntar planilhas / copiar e colar com critérios

Mensagem por srobles »

CH7,

Veja se a rotina abaixo atende sua necessidade.
Adicione um módulo á pasta de trabalho, copie e cole o que segue :

Código: Selecionar todos

Dim linhaIni As Long, linhaFim As Long
Dim retPeca As String, retQtde As String, retVendedor As String
Sub validaDados()
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("VM")
        .Activate
        linhaIni = 2
        linhaFim = .Cells(Rows.Count, 1).End(xlUp).Row
        
            While linhaIni <= linhaFim
                Call pesquisaPersonalisada(.Cells(linhaIni, 2), .Cells(linhaIni, 1), .Cells(linhaIni, 3))
                With ThisWorkbook.Sheets("VM")
                    .Activate
                    .Cells(linhaIni, 5) = retPeca
                    .Cells(linhaIni, 6) = retQtde
                    .Cells(linhaIni, 7) = retVendedor
                End With
                linhaIni = linhaIni + 1
            Wend
        .Activate
        .Cells.EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
    MsgBox "Operação concluída com sucesso!", vbInformation, "Validação de dados"
End Sub
Function pesquisaPersonalisada(ByVal Nome As String, ByVal Marca As String, ByVal ID As String)
    Dim vBusca
    Application.ScreenUpdating = False
    
    retPeca = "-"
    retQtde = "0"
    retVendedor = "-"
    
    With ThisWorkbook.Sheets("WL")
        .Activate
        
        With .Range("A:G")
            
            Set vBusca = .Find(ID)
            
                If Not vBusca Is Nothing Then
                    primeiraOcorrencia = vBusca.Address
                    Range(vBusca.Address).Select
                    If .Cells(vBusca.Row, 1) = Nome And .Cells(vBusca.Row, 2) = ID And .Cells(vBusca.Row, 3) = Marca Then
                        retPeca = .Cells(vBusca.Row, 5)
                        retQtde = .Cells(vBusca.Row, 6)
                        retVendedor = .Cells(vBusca.Row, 7)
                    Else
                        Do
                            Set vBusca = .FindNext(vBusca)
                            If .Cells(vBusca.Row, 1) = Nome And .Cells(vBusca.Row, 2) = ID And .Cells(vBusca.Row, 3) = Marca Then
                                Range(vBusca.Address).Select
                                retPeca = .Cells(vBusca.Row, 5)
                                retQtde = .Cells(vBusca.Row, 6)
                                retVendedor = .Cells(vBusca.Row, 7)
                                Exit Do
                            End If
                        Loop While vBusca.Address <> primeirOcorrencia
                    End If
                
                End If
        End With
        
    End With
End Function
Adicione um botão á aba VM e chame a rotina com call validarDados.

Espero ter ajudado.

Abs


Responder