如何在Excel VBA中根据给定的日期复制单元格值

Question

I attached my table. I want to get date(In inputbox) from Column A and D and copy the adjacent cell value (Column B and E). Then paste in different cell.

For eg. if i enter date 15.10.2016 and 25.10.2017. Then output must be as shown in figure. If the date is not present in the column then Msgbox as invalid date. Help me

Answer 1

This quick method would work for you.

Sub get_money()
        a_col_last_row = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        d_col_last_row = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row
        data_a = InputBox("Enter 1st date")
        data_d = InputBox("Enter 2st date")
        lookup_val_a = ThisWorkbook.Worksheets(1).Cells(3, 8)
        Dim refRng_a As Range
        Dim refRng_d As Range
        Set refRng_a = Range("A2:B" & a_col_last_row)
        'data_a = Cells(3, 8).Value
        Set refRng_d = Range("D2:E" & d_col_last_row)
        'data_d = Cells(3, 9).Value
        On Error GoTo errhandler1:
        Cells(3, 8) = WorksheetFunction.VLookup(data_a, refRng_a, 2, 0)
controlback:
        On Error GoTo errhandler2:
        Cells(3, 9) = WorksheetFunction.VLookup(data_d, refRng_d, 2, 0)

        End
errhandler1:
        MsgBox "1st Value not found"
        Err.Number = 0
        Resume controlback

errhandler2:
        MsgBox " 2nd Value not found"
        Err.Number = 0
End Sub

However please note that I have used the same Range (H3, I3) for input as well as output. I thought you want it that way. You may change it according to your need.