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

Atualizar planilha com condições especificas via macro

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Edeli9
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Sáb Abr 13, 2019 2:09 am

Atualizar planilha com condições especificas via macro

Mensagem por Edeli9 »

Olá amigos. Parabéns ao fórum. Sou fâ de vocês e comecei a desenvolver inspirado nas dicas que são ótimas. Mas estou travado na questão que segue.
Preciso de uma automação via macro para atualizar os dados específicos de uma lista de funcionários de outra planilha(Demitidos). A planilha(Pessoas) que recebe a atualização não contem só nomes de funcionários, mas, prestadores de serviços terceiros etc. ou seja, a macro só deve mexer na célula que contenham FUNÇÃO, SETOR, DEMISSAO (data). Existe uma ferramenta para eliminar duplicado, mas se eu usar ela corre o risco de apagar dados da linha errada. Oque não desejo. Segue um esboço anexo.
Alguém poderia me dar uma forcinha. Desde já obrigado galera.
Anexos
Atualizar.jpg
Atualizar.jpg (209.55 KiB) Exibido 6024 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: Atualizar planilha com condições especificas via macro

Mensagem por srobles »

Edeli9,

A planilha que contém todos os dados que serão importados para a que precisa ser atualizada está em outra pasta de trabalho(outro documento do excel) ou na mesma pasta de trabalho?

Caso esteja em outro documento, veja se a rotina abaixo atende sua necessidade, adapte conforme necessidade :

Código: Selecionar todos

Sub validarLista()
    Dim Matricula As String, Nome As String, Setor, dataDemissao As String
    Dim caminhoPastas As String, planDestino As String, planConsulta As String
    Dim linhaAtual As Long, linhaFinal As Long
    Dim vBusca
    
    caminhoPastas = ThisWorkbook.Path & "\"
    planDestino = ThisWorkbook.Name 'Pasta que precisa ser atualizada
    planConsulta = "Planilha_Completa.xlsx" 'Pasta que contém todos os dados que serão retornados
    
    linhaAtual = 2
    Application.ScreenUpdating = False
inicio:

    Windows(planDestino).Activate
    
    With ActiveWorkbook.Sheets(1)
        
        linhaFinal = .Cells(Rows.Count, 1).End(xlUp).Row
            
            While linhaAtual <= linhaFinal
            
                Matricula = .Cells(linhaAtual, 1)
                Nome = .Cells(linhaAtual, 2)
                Setor = .Cells(linhaAtual, 3)
            
                On Error GoTo trataErro
continuar:
                Windows(planConsulta).Activate
                
                With ActiveWorkbook.Sheets(1)
                    
                    With .Range("A:E")
                        Set vBusca = .Find(Matricula)
                            If Not vBusca Is Nothing Then
                                primeiraOcorrencia = vBusca.Address
                                If Cells(vBusca.Row, 1) = Matricula Then
                                    If Cells(vBusca.Row, 2) = Nome Then
                                        If Cells(vBusca.Row, 3) = Setor Then
                                            If Cells(vBusca.Row, 4) <> vbNullString Then
                                                dataDemissao = Cells(vBusca.Row, 4)
                                            Else
                                                Do
                                                    dataDemissao = ""
                                                    
                                                    Set vBusca = .FindNext(vBusca)
                                                    
                                                    If Not vBusca Is Nothing Then
                                                        Range(vBusca.Address).Select
                                                        If Cells(vBusca.Row, 1) = Matricula Then
                                                            If Cells(vBusca.Row, 2) = Nome Then
                                                                If Cells(vBusca.Row, 3) = Setor Then
                                                                    If Cells(vBusca.Row, 4) <> vbNullString Then
                                                                        dataDemissao = Cells(vBusca.Row, 4)
                                                                        Exit Do
                                                                    End If
                                                                End If
                                                            End If
                                                        End If
                                                    End If
                                                Loop While vBusca.Address <> primeiraOcorrencia
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                    End With
                End With
                Windows(planDestino).Activate
                With ActiveWorkbook.Sheets(1)
                    If dataDemissao <> vbNullString Then
                        .Cells(linhaAtual, 4) = dataDemissao
                    End If
                End With
                linhaAtual = linhaAtual + 1
                GoTo inicio
            Wend
    End With
    MsgBox "Operação concluída com sucesso!", vbInformation, "Validar Dados"
    Workbooks(planConsulta).Close False
    Application.ScreenUpdating = True
    Exit Sub
    
trataErro:
    If Err = 9 Then
        Workbooks.Open (caminhoPastas & planConsulta)
        GoTo continuar
    End If
    
End Sub
Adicione um botão á aba em questão e chame a rotina usando :

Código: Selecionar todos

   Call validarLista
Espero ter ajudado.

Abs


jonsnow1221
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Sex Mai 31, 2019 4:34 am

Re: Atualizar planilha com condições especificas via macro

Mensagem por jonsnow1221 »

I am having an issue on the spreadsheet as the spreadsheet is not beion downloaded and I want it to be printed for my further work. The orining is also not happeniuga nd it is also showing Epson printer errror code e-01 and it has to be fixed.


Edeli9
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Sáb Abr 13, 2019 2:09 am

Re: Atualizar planilha com condições especificas via macro

Mensagem por Edeli9 »

srobles. Brigadão pela luz. Há muitos trabalho com excel, e aos poucos começando a entender um pouco da linguagem VBA. E isso tem me ajudado muito mesmo.
Recebo esta atualização semanalmente. Ela vem numa outra pasta de trabalho(Quadro), são duas, esta e outra de ativos...oque faço atualmente é copiar ela em uma aba da mesma pasta. Depois, Jogo a atualizada obedecendo a ordem das colunas na mesma aba (Mudo a cor da atual e na condicional aplico duplicados para coluna Matricula e nome. Depois ponho em ordem alfabética " Meio pre-histórico" rsrsr), faço isso porque alguns nomes mudam a matricula quando deixam de ser aprendiz ou estagiário), com isso, fica registrado no banco de dados os períodos)..Bem verdade que é meio complexo, mas o banco automatiza, vencimentos de ASO, NRs, CNH, CNV...e outros documentos obrigatórios para determinadas funções tanto para colaboradores internos e terceiros.
Fiz a adaptação mas ainda não consegui atingir o que desejo. Pra ficar mais claro veja abaixo.

Sub validarLista()
Dim Matricula As String, Nome As String, FuncaoDemissao As String, StatusDemissao As String, DataDemissao As String, SetorDemissao As String
Dim caminhoPastas As String, planDestino As String, planConsulta As String
Dim linhaAtual As Long, linhaFinal As Long
Dim vBusca
caminhoPastas = ThisWorkbook.Path & "C:\Users\Edeli9\Desktop\PROJETO_MONITORAMENTO"
planDestino = ("Portaria.xlsm") 'Pasta que precisa ser atualizada
planConsulta = ("Quadro.xlsx") 'Pasta que contém todos os dados que serão retornados
linhaAtual = 3
'Application.ScreenUpdating = False
inicio:
Windows(planDestino).Activate
With ActiveWorkbook.Sheets("Pessoas")
linhaFinal = .Cells(Rows.Count, 1).End(xlUp).Row
While linhaAtual <= linhaFinal
Matricula = .Cells(linhaAtual, 1) 'Matricula
Nome = .Cells(linhaAtual, 2) 'Nome
On Error GoTo trataErro
continuar:
Windows(planConsulta).Activate
With ActiveWorkbook.Sheets("Demitidos") 'Quadro
With .Range("B:k") 'Matricula,Nome,Função,Status e Setor
Set vBusca = .Find(Matricula)
If Not vBusca Is Nothing Then
primeiraOcorrencia = vBusca.Address
If Cells(vBusca.Row, 2) = Matricula Then
If Cells(vBusca.Row, 3) = Nome Then
If Cells(vBusca.Row, 8) <> vbNullString Then 'Data de demissão
FuncaoDemissao = Cells(vBusca.Row, 4)
StatusDemissao = "Ex-FuNC"
DataDemissao = Cells(vBusca.Row, 8)
SetorDemissao = Cells(vBusca.Row, 11)
Else
Do
Set vBusca = .FindNext(vBusca)
If Not vBusca Is Nothing Then
Range(vBusca.Address).Select
If Cells(vBusca.Row, 2) <> Matricula Then
If Cells(vBusca.Row, 3) <> Nome Then
Exit Do
End If
End If
End If
Loop While vBusca.Address <> primeiraOcorrencia
End If
End If
End If
End If
End With
End With
Windows(planDestino).Activate
With ActiveWorkbook.Sheets("Pessoas")
If DataDemissao <> vbNullString Then
.Cells(linhaAtual, 3) = FuncaoDemissao
.Cells(linhaAtual, 4) = StatusDemissao
.Cells(linhaAtual, 7) = DataDemissao
.Cells(linhaAtual, 8) = SetorDemissao
End If
End With
linhaAtual = linhaAtual + 1
GoTo inicio
Wend
End With
MsgBox "Operação concluída com sucesso!", vbInformation, "Validar Dados"
'Workbooks(planConsulta).Close true
'Application.ScreenUpdating = True

If Err = 9 Then
'Workbooks.Open (caminhoPastas & planConsulta)
GoTo continuar
End If
End Sub
Anexos
Atualizar2.jpg
Atualizar2.jpg (237.38 KiB) Exibido 5978 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: Atualizar planilha com condições especificas via macro

Mensagem por srobles »

Edeli9,

Se possível, disponibilize ambos as pastas de trabalho (com dados ficticios) para que eu possa elaborar uma melhor abordagem e a rotina de acordo com a disposição dos dados.

Assim, apenas por fotos, fica complicado acertar de primeira.

Abs


Edeli9
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Sáb Abr 13, 2019 2:09 am

Re: Atualizar planilha com condições especificas via macro

Mensagem por Edeli9 »

srobles. Segue anexo.
Obrigado.


Edeli9
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Sáb Abr 13, 2019 2:09 am

Re: Atualizar planilha com condições especificas via macro

Mensagem por Edeli9 »

Ops..Segue anexo.
Anexos
AtualizaDados.rar
(312.17 KiB) Baixado 199 vezes


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

Re: Atualizar planilha com condições especificas via macro

Mensagem por srobles »

Edeli9,

Fiz as alterações em seus modelos. Favor, teste e retorne.

Apenas se atente para que ambas as pastas de trabalho estejam no mesmo local / diretório.

Espero ter ajudado.

Abs
Anexos
AtualizaDados.rar
(599.72 KiB) Baixado 209 vezes


Edeli9
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Sáb Abr 13, 2019 2:09 am

Re: Atualizar planilha com condições especificas via macro. (RESOLVIDO)

Mensagem por Edeli9 »

srobles. Valeu cara...Ficou perfeito. Muitíssimo obrigado. Agora clareou uma inovação em meu humilde banco de dados. Abraço..Que Deus continue lhe abençoando de sabedoria. 8-)


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

Re: Atualizar planilha com condições especificas via macro

Mensagem por srobles »

Edeli9,

Que boa notícia amigo. Fico mais que satisfeito em saber que a rotina atendeu sua necessidade.

Abs, que Deus abençoe á todos nós e permita que continuemos á ajudar uns aos outros.


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.


Responder