Este fórum está sendo desativado

[GENECI]

Boa tarde!

Solicito a sua ajuda, para solucionar o problema.

Conforme arquivo anexo.

Grato - Geneci.

[Jimmy]

Olá Geneci,

Tentei te ajudar mas a explicação que você deu não foi suficiente para o meu entendimento do problema. Você fala de colunas B, C, D e E, sendo que as colunas C e E estão vazias. Não entendi também onde você quer a mensagem "NÃO CONSTA", se na célula ao lado, ou numa janela.

Sugiro verificar se as colunas que você quis se referir são aquelas mesmas, e também detalhar um pouco mais a explicação, ou dar mais exemplos.

Aparentemente o problema é muito fácil de resolver com macro.

Jimmy San Juan

[GENECI]

Bom dia! Jimmy
Muito obrigado, por atender a minha solicitação.
Realmente houve informações que impossibilitou o entendimento, e as mesmas foram excluídas.
Favor verificar o arquivo anexo.

Grato - Geneci.

[Jimmy]

Geneci,

Ainda há colunas E na descrição do problema, mas acabei entendendo mesmo assim (acho!).

Segue uma planilha para você testar. O resultado que a macro obteve foi parecido com o seu (células amarelas), mas não igual. Tentei achar um possível erro na macro mas não achei. Peço que verifique essa diferença.

Dê retorno!

[GENECI]

Bom dia! Jimmy
A macro esta correta, há um erro o número 56 consta nas duas colunas, divergindo do resultado da macro.
Há possibilidade de colocar em ordem crescente, no inicio das colunas os resultados não pares e eliminar as células vazias nas duas colunas?
Para visualizar fica bem bais fácil.

Grato - Geneci.

[Jimmy]

Olá Geneci,

Geneci,

Primeiro uma correção:
No início da planilha troque o “B” por “D” na linha abaixo:
For Indx = 1 To Range("B" & Rows.Count).End(xlUp).Row
Isso não fez diferença nos testes porque ambas as colunas tem 50 linhas, mas quando a quantidade de linhas das colunas for diferentes, vai fazer diferença.

Segue abaixo a macro já com classificação:

Código: Selecionar todos

Sub ApagaPares()
   'Apaga pares de números entre as colunas B e D
    Atual = ActiveCell.Address
    Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Select
    Msg = "Valore(s) da coluna D, não encontrado(s) na coluna B." & vbCrLf & vbCrLf: MsgFlag = 0
    For Indx = 1 To Range("D" & Rows.Count).End(xlUp).Row
        Alvo = Range("D" & Indx).Value
        On Error Resume Next
        Aqui = Selection.Find(What:=Alvo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                       MatchCase:=False, SearchFormat:=False).Row
        If Err = 0 Then
            Range("B" & Aqui & ",D" & Indx).ClearContents
        Else
            MsgFlag = 1
            Msg = Msg & "Valor " & Alvo & ", linha " & Indx & vbCrLf
        End If
    Next
    
    For Aux1 = 1 To 2
        If Aux1 = 1 Then Col = "B"
        If Aux1 = 2 Then Col = "D"
        Range(Col & "1:" & Col & Range(Col & Rows.Count).End(xlUp).Row).Select
        Selection.Sort Key1:=Range(Col & "1"), Order1:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Next
    
    Range(Atual).Select
    If MsgFlag = 1 Then MsgBox Msg
End Sub

Acho que com a classificação, e todos os números ficando juntos, não há mais a necessidade da mensagem de números não localizados.
A macro abaixo está sem a mensagem:

Código: Selecionar todos

Sub ApagaPares()
   'Apaga pares de números entre as colunas B e D
    Atual = ActiveCell.Address
    Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Select
    For Indx = 1 To Range("D" & Rows.Count).End(xlUp).Row
        Alvo = Range("D" & Indx).Value
        On Error Resume Next
        Aqui = Selection.Find(What:=Alvo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                       MatchCase:=False, SearchFormat:=False).Row
        If Err = 0 Then
            Range("B" & Aqui & ",D" & Indx).ClearContents
        End If
    Next
    
    For Aux1 = 1 To 2
        If Aux1 = 1 Then Col = "B"
        If Aux1 = 2 Then Col = "D"
        Range(Col & "1:" & Col & Range(Col & Rows.Count).End(xlUp).Row).Select
        Selection.Sort Key1:=Range(Col & "1"), Order1:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Next
    
    Range(Atual).Select
End Sub

[GENECI]

Boa tarde! Jimmy
Com suas respostas, amplio meus conhecimentos em VBA.

Muito obrigado.

Grato - Geneci.