Este fórum está sendo desativado

[Saulo]

Boa Tarde!
Solicito ajuda para implementação de uma Função e/ou Macro, que tenha como objetivo evitar entrada duplicatas de dados.
OBS: Esclarecimentos adicionais na planilha em anexo.
Obrigado!

[Basole]

@Saulo veja se é isso

Cole o codigo abaixo no modulo da respectiva aba

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim r As Range
                                               
    Set rng = Range("B4:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    If Not Excel.Application.Intersect(Target, rng) Is Nothing Then
       
    For Each r In rng
        If Excel.Application.CountIfs(Cells(r.Row, 1), _
                Target.Offset(, -1), _
                Cells(r.Row, 2), Target.Value) > 0 And _
                    r.Row <> Target.Row Then
            MsgBox "Já existe a combinação, Selecione outro valor", 16, "Aviso"
            Excel.Application.EnableEvents = False
            Target.Value = ""
            Excel.Application.EnableEvents = True
            Exit For
        End If
     Next
    End If
    Set rng = Nothing
End Sub

[Saulo]

Prezado Basole - 08 Abr 2022 às 18:25
Primeiramente Obrigado Por Dispor de Seu Tempo Para Ajudar-me.
Era isso mesmo, individualmente funcionou, Porém estamos tendo um problema, é o seguinte: tínhamos um colaborador que deixou alguns códigos, aí quando agrego seu código ao projeto, o VB emite a mensagem: “Nome repetido encontrado: Worksheet_Change”, portanto se possível, peço considerar alguma alternativa para parte inicial de seu código: Private Sub Worksheet_Change(ByVal Target As Range), visto que não temos condições técnicas para alterar os demais deixados pelo antigo colaborador.
Até tentamos esse : Private Sub Worksheet_Change(ByVal Target As Excel.Range), mais não funcionou, o VB mantém a crítica.
Desde já Agradeço

[Basole]

Neste caso todos os procedimentos devem ser "juntados" no mesmo evento "Change", colocando condições para não haver confilitos.
Mas sem ver o que já havia sendo feito, difícil opinar

[Saulo]

Boa Tarde, Prezado Basole - 12 Abr 2022 às 14:37
Grato pela paciência.
Anexei novamente a planilha contendo o código do ex-colaborador e o seu , provocando o erro de compilação.
Então... Para Não tomar muito seu tempo, Não Vamos entrar no mérito do código do ex-colaborador.
Solicito se possível, sua análise de viabilidade no sentido de integrar o seu código, ao código atual no mesmo evento "Change"
Atenciosamente

[Basole]

@Saulo

Este código do ex-colaborador, ao executar, altera a lista de validação da coluna B, colocando nas opções de escolha as letras A,B e C ao invés de 1, 2 e 70 do seu exemplo.

[Saulo]

Bom Dia Prezado Basole - 14 Abr 2022 às 18:05
Então....
Note que existe uma outra planilha “BANCO DE DADOS” mesmo na versão anterior e é daí que advém letras A,B e C citadas por Você.
Anexo Planilha Já Com Essa Versão e Também Testei Seu Código Individualmente Com a Nova Planilha e Funcionou Perfeitamente, Porém o Conflito com evento "Change" ao integrar os códigos persistem.
Resumindo: Os dois códigos funcionam perfeitamente de forma individual.
Se For Possível, Peço Por Gentileza Que Verifique a Viabilidade Técnica de Integração Dos Dois Código Existentes (Ex-Colaborador e o Seu) em Somente Um Evento "Change"

Desde Já Agradeço

[Basole]

@Saulo
Boa tarde,
Fiz o que solicitou, agora precisa fazer alguns testes de uso para ver se esta de acordo com o funcionamento adequado.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
  
  If Target.Count > 1 Then Exit Sub
  
  On Error GoTo tr_ERR
  
  Select Case Target.Column
  Case 1
  
  '******************************************************************
  'Código Deixado Pelo Ex-Colaborador
  '******************************************************************
  Dim r, LR As Long
  Excel.Application.ScreenUpdating = False
   Excel.Application.EnableEvents = False
  If Target.Value = "" Then
   Target.Offset(, 1).Value = "": Target.Offset(, 1).Validation.Delete
  Else: [W:W] = ""
   With Sheets("BANCO DE DADOS")
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    LR = .Cells(Rows.Count, 1).End(3).Row
    .Range("A8:F" & LR).AutoFilter 1, Target.Value
    .Range("B10:B" & LR).Copy: [W1].PasteSpecial xlValues
    .ShowAllData
    r = Application.Transpose(Range("W1:W" & Cells(Rows.Count, 23).End(3).Row))
    Target.Offset(, 1).Value = "": Target.Offset(, 1).Validation.Delete
    If Application.CountA([W:W]) > 1 Then
     Target.Offset(, 1).Validation.Add Type:=xlValidateList, Formula1:=Join(r, ",")
    Else: Target.Offset(, 1) = [W1]
    End If
   End With
   [W:W] = ""
   Excel.Application.ScreenUpdating = True
   Excel.Application.EnableEvents = True
  End If

 Case 2
 
'******************************************************************
'Código Desenvolvido no Forum Guru Por Basole -  08 Abr 2022 às 18:25
'******************************************************************
    Dim rng As Range
    Dim c As Range
    
    Set rng = Range("B4:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    If Not Excel.Application.Intersect(Target, rng) Is Nothing Then
       
    For Each c In rng
        If Excel.Application.CountIfs(Cells(c.Row, 1), _
                Target.Offset(, -1), _
                Cells(c.Row, 2), Target.Value) > 0 And _
                    c.Row <> Target.Row Then
            MsgBox "Já existe a combinação, Selecione outro valor", 16, "Aviso"
            Excel.Application.EnableEvents = False
            Target.Value = ""
            Excel.Application.EnableEvents = True
            Exit For
        End If
     Next
    End If
    Set rng = Nothing
  End Select
  
tr_ERR:
   Excel.Application.ScreenUpdating = True
   Excel.Application.EnableEvents = True
  
End Sub

[Saulo]

Prezado Basole - 18 Abr 2022 às 13:55
Primeiro Obrigado Pela Paciência e Compreensão.
Então....
A integração entre as Change Funcionaram, porém as células A4, A5, A6, A7 estão "cogeladas", elas assim como as demais , devem ser flexíveis, observe a partir da coluna A8.
Se possível peço verificar o motivo dos referidos congelamento (células A4, A5, A6, A7)
No Mais Tudo Perfeito.
OBS: Anexo planilha já com a integração das Change
Atenciosamente

[Basole]

A integração entre as Change Funcionaram, porém as células A4, A5, A6, A7 estão "cogeladas", elas assim como as demais , devem ser flexíveis, observe a partir da coluna A8.
Se possível peço verificar o motivo dos referidos congelamento (células A4, A5, A6, A7)
No Mais Tudo Perfeito.

Quando eu baixei o anexo do seu primeiro post de hoje: viewtopic.php?p=70334&sid=ae5ec412216f5 ... 98#p70334
Verifiquei tambem este mesmo congelamento.
O que fiz para resolver isso para poder testar sua planilha .....
Selecionei o intervalo A4:A7 Fui em Dados > Validação de Dados e Cliquei em LIMPAR TUDO.
Em seguida adicionei novamente a lista de validação, ai resolvel este problema.

[Saulo]

Prezado Basole - 18 Abr 2022 às 16:02
Muitíssimo Obrigado Por Dispor de Seu Tempo e Paciência.
Perfeito, Segui Suas Dicas Direitinho, Funcionando 100%.
Atenciosamente