运行Goalseek时循环行和列

Question

在活动工作表中，

我想创建一个值数组，在宏中从特定单元格复制值（比方说“L5”）并将其粘贴到目标单元格（I4）中。此后运行目标搜索并将值粘贴回指定单元格中。然后转到 L6 并重复。执行此操作，直到 L 列中没有值为止。

我尝试了下面的代码，它有效。但我想用变量来简短说明。同时循环运行，直到“L”列中没有值

Sub SOLVER()

    Range("L5").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M5").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N5").PasteSpecial Paste:=xlPasteValues
    Range("L6").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M6").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N6").PasteSpecial Paste:=xlPasteValues
    Range("L7").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M7").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N7").PasteSpecial Paste:=xlPasteValues
    Range("L8").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M8").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N8").PasteSpecial Paste:=xlPasteValues
    Range("L9").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M9").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N9").PasteSpecial Paste:=xlPasteValues
    Range("L10").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M10").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N10").PasteSpecial Paste:=xlPasteValues
    Range("L11").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M11").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N11").PasteSpecial Paste:=xlPasteValues
    
End Sub

Answer 1

请尝试一下。

Option Explicit

Sub SOLVER()
    Dim lastRow As Long, i As Long
    Dim lastRow As Long, oSht As Worksheet
    With Sheets("Sheet1")  ' modify as needed
        lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
        For i = 5 To lastRow
            .Range("I4").Value = .Range("L" & i).Value
            .Range("J4").GoalSeek Goal:=0, ChangingCell:=.Range("D23")
            .Range("M" & i).Value = .Range("D23").Value
            .Range("N" & i).Value = .Range("H5").Value
        Next
    End With
End Sub