これより早い処理速度のコードに変更できますか? Sub SearchAndExtractData() Dim wsSearch As Worksheet Dim lastRowSearch As Long Dim wbData As Workbook Dim wsData As Worksheet Dim lastRowData As Long Dim i As Long, j As Long Dim dataFilePath As String ' 検索ブックのシートを設定 Set wsSearch = ThisWorkbook.Sheets("Sheet1") lastRowSearch = wsSearch.Cells(wsSearch.Rows.Count, "A").End(xlUp).Row ' データ.csvファイルのパスを取得 dataFilePath = ThisWorkbook.Path & "\データ.csv" ' データ.csvファイルが開かれているか確認 On Error Resume Next Set wbData = Workbooks("データ.csv") On Error GoTo 0 ' データ.csvファイルが開かれていない場合、開く If wbData Is Nothing Then Set wbData = Workbooks.Open(dataFilePath) End If Set wsData = wbData.Sheets("データ") lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False ' screenupdatingをFalseに設定 ' データを検索して抽出 For i = 2 To lastRowSearch For j = 2 To lastRowData If wsSearch.Cells(i, "A").Value = wsData.Cells(j, "A").Value And _ wsSearch.Cells(i, "B").Value = wsData.Cells(j, "B").Value Then ' 貸出時間をコピー wsSearch.Cells(i, "C").Value = wsData.Cells(j, "C").Value ' 返却時間をコピー wsSearch.Cells(i, "D").Value = wsData.Cells(j, "D").Value Exit For End If Next j Next i Application.ScreenUpdating = True ' screenupdatingをTrueに戻す ' データ.csvを閉じる(ファイルを開いていない場合のみ) If wbData.Name <> ThisWorkbook.Name Then wbData.Close SaveChanges:=False End If End Sub
Excel