function에 설정되어 있는 기준을 자동으로 변경해 반복작업하게 할 수 있을까요 ?

안녕하세요

현재 Q열의 값을 기준으로 Q열의 값과 I열과 값이 같은 행을 선택 후 선택된 행 중 D열만 선택, D열의 값 중 가장 큰 값과 그 옆의 E셀의 값을 비교하여

F셀에 넣어주는 vba코드를 만들고자 합니다.

(BOX재고와 주문수량을 비교하여 BOX재고보다 주문수량이 많은 경우 재고 전부를,

재고가 주문수량보다 많을 경우 주문 수량을 이동수량에 자동으로 넣어주는 vba코드를 만들고 싶습니다.)

vba코드를 실행하여 한번 넣는건 성공하였으나 fuction을 사용하여 기준을 Q3셀로 설정해놓아

반복작업이 안되는거 같습니다..

혹시 반복작업이 가능하려면 어떤부분을 수정해야하는지 아니면 전부 바꿔야는지...ㅜㅜㅜ

아래 캡쳐사진과 코드를 붙여놓았습니다..

아시는분 가르침 좀 부탁드립니다..!

Function SelectMaxValueCellInSelectedRows() As Range
Dim lastRow As Long
Dim rng As Range
Dim cell As Range
Dim criteria As Variant
Dim maxVal As Double
Dim maxCell As Range

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

criteria = Cells(3, 17).Value

For Each cell In Range("i3:i" & lastRow)
If cell.Value = criteria Then
If rng Is Nothing Then
Set rng = cell.EntireRow
Else
Set rng = Union(rng, cell.EntireRow)
End If
End If
Next cell

If Not rng Is Nothing Then
rng.Select
rng.Columns("D").Select
End If

maxVal = Application.WorksheetFunction.Max(Selection)

Set maxCell = Selection.Find(What:=maxVal, LookIn:=xlValues, LookAt:=xlWhole)

Set SelectMaxValueCellInSelectedRows = maxCell
End Function

-------------------------------------------------------------------------------

Sub ExampleUsage()
Dim maxCell As Range
Set maxCell = SelectMaxValueCellInSelectedRows()
If Not maxCell Is Nothing Then
maxCell.Select
End If

Dim selectedRange As Range
Dim cell As Range

Set selectedRange = Selection

For Each cell In selectedRange

If cell.Value > cell.Offset(0, 1).Value Then

cell.Offset(0, 2).Value = cell.Offset(0, 1).Value
Else

cell.Offset(0, 2).Value = cell.Value
End If
Next cell

End Sub