Это пятница, вот, пожалуйста, на что посмотреть и изучить.Мне жаль, что я не использовал Vlookup, я потратил слишком много времени на погоню за призраками.Возможно, другие добились большего успеха, я думаю, что мне не нравится Vlookup, если он не дает точного соответствия, иногда он выбирает соседний ряд и бросает все в суматоху.
Вот оно:
Option Explicit
Private Sub CommandButton2_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lrow2 As Long
Dim lrow1 As Long
Dim firstDataRow As Double
Dim matchRange As Range
Dim matchRow As Long
Dim i As Long
'Set up your Worksheet variables
Set ws1 = ThisWorkbook.Worksheets("DG")
Set ws2 = ThisWorkbook.Worksheets("Asp")
'You used A5 several times, so I will assume dates are in Col A and start at row 5
'Set your row with first data, maybe you need two, if they are the same on both sheets you don't
firstDataRow = 5
'find the last row on each sheet, using column A, the date col
lrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'In your mind you now have two data ranges, one for each sheet, rows 5-last dat rows
'Pick one sheet, the one with less dates would be more efficient, you mention DG has less
'So this might be built backwards from what you are thinking, since we are iterating each row in the col
'You want to use the shrter call, IF you know its shorter (your comments)
'Loop through each row trying to find a match on your other sheet
For i = firstDataRow To lrow1
If ws1.Cells(i, "A") <> "" Then 'Test for empty
'Here is the premise of Find/Match over Vlookup
Set matchRange = ws2.Range("A" & firstDataRow & ":A" & lrow2).Find(ws1.Cells(i, "A"))
On Error Resume Next
matchRow = matchRange.Row 'Returns row number or nothing
If (Not matchRange Is Nothing) Then
'we have a row number matched on Asp, for our search item on DG
'perform the "Copy", this can be done differently but here I am going to introduce you to a way
'that can later be used with offsets and col #s, so that you may skip columns, data is not always adjacent
ws2.Cells(matchRow, "E") = ws1.Cells(i, "B")
ws2.Cells(matchRow, "F") = ws1.Cells(i, "C")
ws2.Cells(matchRow, "G") = ws1.Cells(i, "D")
Else 'DO NOTHING
End If
Else 'DO NOTHING
End If
Next i
MsgBox "Search and Copy is complete.", vbInformation, "Completed"
End Sub
В этом простом проекте можно еще много рассказать о том, чтобы сделать это более пуленепробиваемым.Но это хорошее начало для того, где вы находитесь.
Ура!Удачного кодирования!- WWC