Sub 複数条件の検索() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim Date1 As String Dim Date2 As String Dim TERM As String Dim MaxRow As Long Dim MaxRow2 As Long Dim i As Long Dim ii As Long Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") MaxRow = WS1.Range("B1").End(xlDown).Row i = 2 For i = i To MaxRow Date1 = WS1.Cells(i, 2) & WS1.Cells(i, 3) & WS1.Cells(i, 4) MaxRow2 = WS2.Range("B1").End(xlDown).Row '最終行を取得 ii = 2 For ii = ii To MaxRow2 Date2 = WS2.Cells(ii, 2) & WS2.Cells(ii, 3) & WS2.Cells(ii, 4) If Date1 = Date2 Then TERM = WS2.Cells(ii, 1) WS1.Cells(i, 1) = TERM Exit For End If Next ii Next i End Sub