Visual Basic vba comparação de valores entre tabelas

Ismael Souza · 3 de junho de 2020

Bom dia pessoal !

Gostaria de compartilhar uma dúvida e tentar uma ajuda !

Primeiramente, eu não posso enviar a planilha aqui pois estou em ambiente corporativo onde sou proibido de compartilhar arquivos, qualquer que seja.

Bom vamos lá, abaixo tenho as duas tabelas :

A B

SM-A2323 SM-A2323

SM-A5890 SM-A6060

SM-A6060 SM-A8080

Eu preciso fazer a checagem de cada celula da coluna A que esta na Pan1, se contem na coluna B da Plan2.

Se o valor de alguma célula da coluna A da Plan1, não existir na coluna B da Plan 2, na coluna B da plan 2, inserir um linha, adicionar o valor que não existe ordena em ordem alfabética.

Parece simples, mas não consegui desenvolver um código simples pra isso.

Poderiam me ajudar com isso?

Muito obrigado !

Midori · 3 de junho de 2020

@Ismael Souza Você pode fazer um loop verificar cada linha da coluna A e ir comparando cada valor com a coluna B com Find ou alguma outra função de WorksheetFunction como Match.

Ismael Souza · 3 de junho de 2020

Olá Midori !

Eu tentei fazer loops com Find mas na hora de ir pra celula seguinte na Coluna A que estou com dificuldade.

Midori · 3 de junho de 2020

@Ismael Souza Para pegar cada linha use For Each, p.ex

Dim R   As Range

For Each R In Worksheets("Plan1").[A1:A3]
    MsgBox R
Next R

Ismael Souza · 3 de junho de 2020

@Midori se eu definir o range [A1:A3], quando for adicionado uma nova informação o range aumenta. certo?

Nisso o código não vai procurar corretamente.

Midori · 3 de junho de 2020

@Ismael Souza Para pegar todas as linhas pode ser assim,

For Each R In Range("A1:" & Range("A1").End(xlDown).Address)

Next R

Ismael Souza · 3 de junho de 2020

Tentei isso mas não deu certo :

Dim r As Range

Set r = Worksheets(3).Range("D5:D80") -> Ex: seria a coluna A, plan1

For Each r In Range("B4:" & Range("B4").End(xlDown).Address) -> Ex: coluna B, plan2

If r Is Nothing Then
Worksheets(4).Range("B4").Select
Selection.Insert
ActiveCell.Value = r
End If
Next r

Midori · 3 de junho de 2020

@Ismael Souza Fiz de uma forma fácil de adaptar, veja se resolve.

Sub Macro()
    Dim A, B, R As Object
        
    Set A = ThisWorkbook.Worksheets("Plan1")
    Set B = ThisWorkbook.Worksheets("Plan2")
        
    For Each R In A.[A1:A3]
        If B.[B:B].Find(R) Is Nothing Then
            B.[B1048576].End(xlUp).Offset(1) = R
        End If
    Next R
End Sub

Ismael Souza · 3 de junho de 2020

Desculpe @Midori, sou iniciante em VBA e não consegui desenvolver pra tudo que me referi.

adicionado 50 minutos depois

@Midori

Fiz essa adaptação mas não funcionou, esta adicionando uma linha mesmo se já existir o valor da coluna A na coluna B.

sub Macro()
Dim A, B, R As Object

Set A = ThisWorkbook.Worksheets(3)
Set B = ThisWorkbook.Worksheets(4)

For Each R In A.[D5:D80] ' o valor aqui é um inexistente, beleza
If not B.[B:B].Find(R) Is Nothing Then
B.[B5].Select
Selection.Insert
ActiveCell.Value = R

End If
Next R 'quando eu digo next R, os proximos valores já existem, mas mesmo assim esta adicionando
End Sub

Midori · 3 de junho de 2020

@Ismael Souza A macro completa já com a função de ordenação.

Sub Macro()
    Dim A, B, R As Object
      
    Set A = ThisWorkbook.Worksheets("Plan1")
    Set B = ThisWorkbook.Worksheets("Plan2")
    
    For Each R In A.Range("A2:A" & A.Range("A1").End(xlDown).Row)
        If B.[B:B].Find(R) Is Nothing Then
            B.[B1048576].End(xlUp).Offset(1) = R
        End If
    Next R
    
    B.Sort.SortFields.Clear
    B.Sort.SortFields.Add2 Key:=B.Range("B2"), Order:=xlAscending
    B.Sort.SetRange B.Range("B1:B" & B.Range("B1").End(xlDown).Row)
    B.Sort.Apply
End Sub

adicionado 3 minutos depois