創建具有可變步長的 2 個數字之間的值列表

Question

我試圖列出 2 個數字之間的所有值，但每組的間隔各不相同。 例如，我想以 0.5 的增量列出（包括）1 - 5 之間的所有數字，並以 10 的增量列出 40 - 140 之間的所有值，如下所示。 輸入的總數會有所不同（我目前有 15 個），所以我試圖避免為每個新輸入編寫一個新循環。

我找到了來自hiker95 的原始代碼，除了可變步長之外，它完全符合我的要求，而且我終其一生都無法弄清楚如何正確修改它。 任何幫助將不勝感激 - 我認為錯誤必須在循環結束時調用步長？ 原始代碼如下：

Sub RangeToList()
' original code by hiker95, 08/21/2014, ME800450
' Create list of all values between upper and lower parameter values with specified interval


Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, i As Long
Dim r As Long, lr As Long, nc As Long, c As Range
Dim MyStart As Long, MyStop As Long, n As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
a = w1.Range("A1:B" & lr).Value
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.ClearContents
  For i = 1 To lr
    nc = nc + 1
    .Cells(1, nc).Value = a(i, 1)
    .Cells(2, nc).Value = a(i, 2)
  Next i
  For Each c In .Range(.Cells(1, 1), .Cells(1, lr))
    MyStart = .Cells(1, c.Column)
    MyStop = .Cells(2, c.Column)
    n = (MyStop - MyStart) + 1
    .Cells(3, c.Column) = "Test Points"
    .Cells(4, c.Column) = MyStart
    With .Range(.Cells(4, c.Column), .Cells(n + 3, c.Column))
      .DataSeries Step:=1, Stop:=MyStop
    End With
  Next c
  .Columns.AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Answer 1

假設您的工作表是這樣設置的，下面的示例將根據您的示例工作表 output。 我不知道有什么方法可以在 1 個循環中實現這一點，但您可以按照以下示例將 2 個或更多循環合並到您的例程中，重用第 2 個示例方法。

注意：這些示例寫在新工作簿的新工作表上。 工作簿/工作表未經過限定，默認情況下假定為“Sheet1”。

'This example will output per your 1st criteria. 
Private Sub ExampleForLoopWithHalfStep()
    Dim LoopCounter As Double
    Dim RowCounter As Long
    RowCounter = 5
    
    For LoopCounter = 1 To 5 Step 0.5
        RowCounter = RowCounter + 1
        Cells(RowCounter, 2).Value = LoopCounter    'Starts at cell B6
    Next LoopCounter
End Sub

'This example will output per your 2nd criteria. 
Private Sub ExampleForLoopWithTenStep()
    Dim LoopCounter As Double
    Dim RowCounter As Long
    RowCounter = 5
    
    For LoopCounter = 40 To 140 Step 10
        RowCounter = RowCounter + 1
        Cells(RowCounter, 3).Value = LoopCounter    'Starts at cell C6
    Next LoopCounter
End Sub

這些示例從 1 到 5 步長 0.5 循環，每次迭代提供 output，增量為 0.5，從 40 到 140 步長 10，每次迭代提供 output，增量為 10。

---

現在，如果我們想讓它更具動態性，我們可以使用變量或范圍引用來引用工作表的“輸入”部分，如下所示：

'This example will output per your 1st criteria. 
Private Sub ExampleForLoopWithHalfStep()
    Dim LoopCounter As Double
    Dim RowCounter As Long
    Dim MinValue As Long
    Dim MaxValue As Long
    Dim StepValue As Double
    
    RowCounter = 5
    MinValue = Range("B2").Value
    MaxValue = Range("C2").Value
    StepValue = Range("D2").Value
        
    For LoopCounter = MinValue To MaxValue Step StepValue
        RowCounter = RowCounter + 1
        Cells(RowCounter, 2).Value = LoopCounter    'Starts at cell B6
    Next LoopCounter
End Sub

'This example will output per your 2nd criteria. 
Private Sub ExampleForLoopWithTenStep()
    Dim LoopCounter As Double
    Dim RowCounter As Long
    Dim MinValue As Long
    Dim MaxValue As Long
    Dim StepValue As Double
    
    RowCounter = 5
    MinValue = Range("B3").Value
    MaxValue = Range("C3").Value
    StepValue = Range("D3").Value
    
    For LoopCounter = MinValue To MaxValue Step StepValue
        RowCounter = RowCounter + 1
        Cells(RowCounter, 3).Value = LoopCounter    'Starts at cell C6
    Next LoopCounter
End Sub

兩組示例都在做完全相同的事情，只是第二組示例可以讓您通過更新工作表上的“輸入”范圍（低、高和間隔單元格）來更改循環的標准。

---

避免單獨的循環

這是假設輸入的布局與您的示例數據一樣； 在不知道數據的來龍去脈的情況下，很難編寫出 100% 合理的解決方案，但是上述例程的修改后的代碼將動態運行所有輸入和 output 逐列所需的值（如下所示。

Private Sub ExampleDynamicForLoop()
    Dim LoopCounter As Double
    Dim RowCounter As Long
    Dim MinValue As Long
    Dim MaxValue As Long
    Dim StepValue As Double
    Dim InputRange As Range
    Dim TargetCell As Range
    Dim RangeCounter As Long
    
    RowCounter = 5
    
    Set InputRange = EstablishInputCount(1, 1) 'Change this to reference the correct StartRow and TargetColumn to suit your data.
    For Each TargetCell In InputRange
        RangeCounter = RangeCounter + 1
        If TargetCell.Value Like "Input*" Then
            MinValue = TargetCell.Offset(0, 1).Value
            MaxValue = TargetCell.Offset(0, 2).Value
            StepValue = TargetCell.Offset(0, 3).Value
            For LoopCounter = MinValue To MaxValue Step StepValue
                RowCounter = RowCounter + 1
                Cells(RowCounter, RangeCounter).Value = LoopCounter    'Starts at cell C6
            Next LoopCounter
            RowCounter = 5
        End If
    Next TargetCell
End Sub

這也在同一個代碼模塊中使用了這個 Function：

Private Function EstablishInputCount(ByVal StartRow As Long, ByVal TargetColumn As Long) As Range
    Dim LastRow As Long
    With Sheet1
        LastRow = .Cells(.Rows.Count, TargetColumn).End(xlUp).Row
        Set EstablishInputCount = .Range(.Cells(StartRow, TargetColumn).Address, .Cells(LastRow, TargetColumn).Address)
    End With
End Function

使用與以前相同的示例數據，我使用您提供的 2 個輸入以及一個新輸入和 output 對其進行了測試：

請記住，這是從Row 6開始的Column B硬編碼為 output，因此您需要根據需要調整代碼中的這些引用以及輸入的位置。