執行一系列單元格的循環

Question

這是一個非常基本的問題，我相信已經回答了，但我似乎在其他地方找不到。 我有一部分vba代碼對單個單元格工作正常。 但是，我想擴展它以適用於一定范圍的單元格（都在同一列內）。

基本上，它是一個目標搜索循環，它更改“ b”列中的值，直到“ w”列中的值與“ x”列中的值匹配（在99％以內）。

什么有效：

Sub Goalseeker()

Do Until Range("w32").Value / Range("x32").Value > 0.99
    Range("b32").Value = Range("b32").Value - 1
Loop

End Sub

我想將其擴展到適用於第32到107行。我嘗試了：編輯：我已經根據收到的信息和經過調整的注釋以及在生效之前的一些事情進行了調整。 如果有人對此過程感興趣：

Option Explicit

Sub Goalseeker()

Dim i As Integer
Dim targetcell As Double
Dim outputcell As Double
Dim variablecell As Range

For i = 32 To 107

targetcell = Cells(i, "x")
outputcell = Cells(i, "w")
Set variablecell = Range("B" & i)

Do Until outputcell / targetcell > 0.99
    variablecell = variablecell - 1
    targetcell = Cells(i, "x")
    outputcell = Cells(i, "w")
Loop

Next

End Sub

我必須調整的一點是

Do Until outputcell / targetcell > 0.99
    variablecell = variablecell - 1
    targetcell = Cells(i, "x")
    outputcell = Cells(i, "w")
Loop

必須重新定義目標單元格和輸出單元格（如果這是一個錯誤的詞，我對此表示歉意），以防止無限循環。

謝謝大家 我將為相對引用而不是絕對引用創建此函數。

Answer 1

這里的問題很少。 將您的For i循環更改為For i = x to y的格式For i = x to y而不將For i = x to i = y的格式

您可以將targetcell和outputcell稱為double但variablecell必須是一個range 。 如果是range則需要Set

您應該聲明所有變量，如下所示。

最后，您可能想抓住一個機會擺脫無限循環（以防目標永遠不會超過0.99嗎？）

Sub Goalseeker()

Dim i As Integer

Dim targetcell As Double
Dim outputcell As Double
Dim variablecell As Range

For i = 32 To 107

    targetcell = Cells(i, "x")
    outputcell = Cells(i, "w")
Set variablecell = Range("B" & i)

    Do Until outputcell / targetcell > 0.99
        variablecell = variablecell - 1
    Loop

Next

End Sub

Answer 2

考慮以下示例表：

使用下面的代碼在“ B”列中找到正確的值（如圖所示），以最大程度地減少結果（下一個列）和目標（兩個以上的列）之間的誤差。

Option Explicit

Public Sub GoalSeekMyValues()

    ' Call GoalSeek with inputvalues "B2:B16", having the result
    ' at column offset 1, and the goal in column offset 2.
    ' Note that Range("B2").Resize(15, 1) = Range("B2:B16"),
    ' But I prefer the top cell and row count of this syntax.
    GoalSeek Range("B2").Resize(15, 1), 1, 2

End Sub

Public Sub GoalSeek(ByVal variables As Range, ByVal result_offset As Long, ByVal goal_offset As Long)
    Dim n As Long, i As Long, pct_error As Double, last_error As Double
    'x is the input value (variable)
    'y is the result
    'g is the goal for y
    Dim x As Double, y As Double, g As Double
    ' Read the number of rows in the input values
    n = variables.Rows.Count
    Dim r As Range
    ' Loop through the rows
    For i = 1 To n
        'Set a range reference at the i-th input cell
        Set r = variables.Cells(i, 1)
        ' Read the value, the result and the goal
        x = r.Value
        y = r.Offset(0, result_offset).Value
        g = r.Offset(0, goal_offset).Value
        pct_error = Abs(y / g - 1)
        Do
            'Set the next value
            r.Value = x - 1
            ' Read the result (assume goal doesn't change)
            y = r.Offset(0, result_offset).Value
            ' Keep last error, and calculate new one
            last_error = pct_error
            pct_error = Abs(y / g - 1)
            ' If new error is more than last then exit the loop
            ' and keep the previous value (with less error).
            If pct_error > last_error Then
                ' Keep last value
                r.Value = x
                Exit Do
            End If
            ' read the input value
            x = r.Value
            ' Assume inputs must be positive so end the loop
            ' on zero on negative numbers
        Loop Until x <= 0
    Next i
End Sub

---

您的代碼有很多失敗點 。

1. 您的代碼可能永遠無法解決，並且excel會掛起（直到按Ctrl - Break為止）。 當輸入變為零或負數時，我很難過。 其他問題則需要其他方式來說明沒有解決方案。
2. 第一次結果在解決方案的1％之內可能不會產生最小誤差 。 我通過跟蹤相對誤差的絕對值來解決這個問題。 只有當錯誤開始增加時，我才終止循環。 這假定將輸入減少一個單位將改善解決方案（至少在最初是這樣）。 如果不是這種情況，代碼將失敗。

3. 您使用絕對引用（例如讀取第12個單元格向下和第4個單元格），這不是非常可重用的編程樣式。 我總是嘗試使用相對引用。 我從左上角的引用單元格開始（在本例中為B2 ），然后使用以下方法從那里向下和向右移動：

   • Range("B2").Cells(5,1) -從B2引用第5行和第1列。
   • Range("B2").Resize(15, 1) -擴展范圍以包括15行和一列。
   • Range("B2).Cells(i,1).Offset(0, 3) -從第i行開始，使用列偏移量3（表示表中的第4列）。

4. 我建議使用一種常見的目標搜索方法（如二等分），或者更好的方法是使用內置的目標搜索功能

例：

Range("B2").Cells(i,2).GoalSeek Goal:=Range("B2").Cells(i,3).Value, ChangingCell:=Range("B2").Cells(i,1)