intersection

Tatu

New Member
Joined
Jun 18, 2020
Messages
6
Como posso encontrar dados na folha2 e fazer corresponder na folha1, encontrando a intersecção e preenchendo as células com cor
 

Attachments

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,184
Office Version
2007
Platform
Windows
Tente a seguinte macro:

VBA Code:
Sub intersection_Dates()
  Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range
  Dim a As Variant, b As Variant, c As Variant, dic1 As Object, dic2 As Object
  Dim i As Long, j As Long, k As Long, nRow As Long
  
  Set sh1 = Sheets("Folha1")
  Set sh2 = Sheets("Folha2")
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  Set rng = sh1.Range("A1")
  
  sh1.Range("D4", sh1.Cells(Rows.Count, Columns.Count)).Interior.Color = xlNone
  a = sh1.Range("A4", sh1.Range("A" & Rows.Count).End(3)).Value2
  b = sh1.Range("D3", sh1.Cells(3, Columns.Count).End(1)).Value2
  c = sh2.Range("A4", sh2.Cells(sh2.Range("A" & Rows.Count).End(3).Row, _
                      sh2.Cells(3, Columns.Count).End(1).Column)).Value2
  
  For i = 1 To UBound(a, 1)
    dic1(a(i, 1)) = i + 3   'rows
  Next
  For i = 1 To UBound(b, 2)
    dic2(b(1, i)) = i + 3   'columns
  Next
  
  For i = 1 To UBound(c, 1)
    If dic1.exists(c(i, 1)) Then
      nRow = dic1(c(i, 1))
      For j = 4 To UBound(c, 2) Step 2
        If c(i, j) = "" Then Exit For
        For k = c(i, j) To c(i, j + 1)
          If dic2.exists(k) Then Set rng = Union(rng, sh1.Cells(nRow, dic2(k)))
        Next k
      Next j
    End If
  Next i
  
  rng.Interior.Color = vbYellow
  sh1.Range("A1").Interior.Color = xlNone
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,184
Office Version
2007
Platform
Windows
Fico feliz em ajudá-lo, obrigado por comentar.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,350
Messages
5,486,349
Members
407,541
Latest member
Emilybuhman

This Week's Hot Topics

Top