Jump to content
flavioterto

[Resolvido] VBA - Comparando colunas

Recommended Posts

flavioterto

Bom dia!

Tenho um banco de dados com contactos na qual deve ser atualizado com novos contactos sempre que houver um evento. A contacto obtido no novo evento pode já está no banco de dados ou ter alterado alguma informação pessoal ou ser realmente informação nova. Para diferenciar quem está ou não, resolvi pesquisar pelo e-mail.

O que pode acontecer:

  • Se o e-mail não está na lista = pinta a rosa a linha do novo contacto que não está na lista.
  • Se já existe o e-mail, digo para ele checar nome da pessoa, empresa e função.
  • Se algumas das informações não são iguais, mando ele pintar a linha a verde.
  • Se todas as informações forem iguais mando ele substituir a coluna da situação do evento (c, env, nenv etc) na coluna relativa ao evento no banco de dados principal.

Tentei fazer diversos códigos, mas ainda não obtive êxito total. Por exemplo, ele compara, mas não pinta a linha do falso, mas sim toda planilha ou só a célula ativada pelo cursor.

Segue a linha de comandos que, provavelmente errada, faz-me sentido.

#
Sub BD_Empresas ()
Dim i as Integer
Dim comparar(A) as String
Dim comparar(C) as String
Dim comparar(C) as String
  For i = 2 to 10000
  If worksheets(2).cells(i,5) = worksheets(1).cell(i,5) Then
    Comparar (A) = worksheets(2).cells(i,2) = worksheets(1).cell(i,2)
    Comparar (B) = worksheets(2).cells(i,3) = worksheets(1).cell(i,3)
    Comparar (C) = worksheets(2).cells(i,4) = worksheets(1).cell(i,4)
  Elseif linhas = Selection.Row - 1 & ":" & Selection.Row =worksheets(1).cells(i,5) <> worksheets(2).cell(i,5)
    Rows(linhas).Interior.ColorIndex = 7
  End If

  If Comparar (A) and Comparar (B) and Comparar (C) = True then
    Copy worksheets(2).Cell( ) in worksheets(1).Cell( )
  Elseif linhas = Selection.Row - 1 & ":" & Comparar (A) <> Comparar (B) <> Comparar (C)
    Rows(linhas).Interior.ColorIndex = 3
  End If
End Sub
#

Minhas principais dúvidas:

- Como comparar cada novo e-mail com todos os valores da coluna de e-mail do Banco de dados principal? (o mesmo para o nome, a função e a empresa);

- Como colorir a linha daquilo que exatamente deu falso?;

- Como copiar o estado da linha que exatamente deu certo?;

- Essa maneira conjunta de testar (comparar(a)=comparar(b)=comparar(c)) está correta?

Desde já, muito obrigado!

Share this post


Link to post
Share on other sites
flavioterto

A quem interessar possa:

1 - Buscar se os novos emails na coluna "D" na o worksheet.2 já existe na coluna "D" do worksheet.1

1.1 - Verdadeiro: Se já existe = comparar Nome, Entidade e função

1.1 - Falso: Se não existe = pintar linha ou célula do email a rosa

2 - 1.1 Verdadeiro (Nome, Empresa e função forem o mesmo), copiar a coluna de estado (Logo) da worksheet.2 para a coluna correspodente do evento na worksheet.1

2.1 - 1.1 é falso (Alguma das informações é diferente das já existentes para o email) = pintar a verde linha ou célula.

Option Explicit
Sub ProcuraEMail()
  Dim em As Range
  Dim i As Integer
  Dim D As Integer
  Dim C As Integer
  Dim B As Integer
  Dim A As Integer
  For i = 2 To 5
    With Sheets("BD_Empresas")
    Set em = .[D:D].Find(Cells(i, 4), Lookat:=xlWhole)
    If Not em Is Nothing Then
      D = 1
    Else: D = 0
    End If
    Set em = .[C:C].Find(Cells(i, 3), Lookat:=xlWhole)

    If Not em Is Nothing Then
      C = 1
    Else: C = 0
    End If
    Set em = .[b:B].Find(Cells(i, 2), Lookat:=xlWhole)
    If Not em Is Nothing Then
      B = 1
    Else: B = 0
    End If
    Set em = .[A:A].Find(Cells(i, 1), Lookat:=xlWhole)
    If Not em Is Nothing Then
      A = 1
    Else: A = 0
    End If
    If A = 1 And B = 1 And C = 1 And D = 1 Then
      .Cells(em.Row, 5).Resize(, 1).Value = Cells(i, 5).Resize(, 1).Value
    End If
    If D = 0 Then
      Cells(i, 4).Interior.ColorIndex = 7
    End If
    If A = 0 Then
      Cells(i, 1).Interior.ColorIndex = 3
    End If
      If B = 0 Then
      Cells(i, 2).Interior.ColorIndex = 4
    End If
    If C = 0 Then
      Cells(i, 3).Interior.ColorIndex = 6
    End If
  End With
  Next i
End Sub

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.