Сопоставление одинаковых дат в разных столбцах

Question

Столбцы дат на этом листе не совпадают. Я хочу, чтобы даты в столбце E соответствовали датам в столбце A и отображали цены закрытия как VALUES, так и MARKET CAP. Даты в столбце E, которых нет в столбце A, следует исключить. Я приложил скриншот листов, код, который я пробовал, и лист того, каким должен быть результат.

Option Explicit       
Sub matchdates()      
 Dim finalrow As Long, i As Integer      
 Sheet2.Range("A7").Select       
finalrow = Sheet2.Range("A5000").End(xlUp).Row            
For i = 4 To finalrow               
 If Range("A7") = Range("E7") Then              
     Range(Cells(i, 1), Cells(i, 2)).Copy             
     Range(Cells(i, 5), Cells(i, 6)).Copy          
     Range("k100").end(xlUp).Offset(1, 0).PasteSpecial             
End If          
Next i          
End Sub          

Answer 1

Пожалуйста, проверьте следующий код. Возвращается, начиная с диапазона «K4: M4»:

Sub matchdates()
 Dim sh As Worksheet, lastRA As Long, lastRE As Long, i As Long, j As Long
 Dim arrA As Variant, arrE As Variant, arrRez As Variant, k As Long

 Set sh =  sheet2 'use here your real sheet
 lastRA = sh.Range("A" & sh.Rows.count).End(xlUp).Row
 lastRE = sh.Range("E" & sh.Rows.count).End(xlUp).Row
  arrA = sh.Range("A4:B" & lastRA).Value 'input the range in an array
  arrE = sh.Range("E4:F" & lastRE).Value 'input the range in an array
  ReDim arrRez(1 To UBound(arrA, 1), 1 To 3) ' set dimension of the array
                                             ' collecting the resultr
  k = 1 'initialize the first arrRez row number
 For i = 1 To UBound(arrA, 1)
    For j = 1 To UBound(arrE, 1)
        If DateValue(arrA(i, 1)) = DateValue(arrE(j, 1)) Then 'when a match is found (independent of sorting):
            'the array collecting the result is loaded with the appropriate mathching data:
            arrRez(k, 1) = arrA(i, 1): arrRez(k, 2) = arrA(i, 2): arrRez(k, 3) = arrE(j, 2)
            k = k + 1 'the array row number is incremented
            Exit For  'exiting the loop in order to save time
        End If
    Next j
 Next i
 If arrRez(1, 1) <> Empty Then
    'the array keeping the matching result drops its data:
    With sh.Range("K4:M" & k + 2)
        .Value = arrRez
        .EntireColumn.AutoFit 'a little format to column autofit
    End With
 End If
End Sub