创建具有可变步长的 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

假设您的工作表是这样设置的，以下示例将根据您的示例工作表输出。我不知道有什么方法可以在 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 循环，每次迭代以 0.5 的增量提供输出，以及从 40 到 140 步长 10 的循环，每次迭代以 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% 可靠的解决方案，但是上述例程的修改后的代码将动态运行所有输入并逐列输出所需的值（如下所示。

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 个输入和一个新输入对此进行了测试，并按预期输出：

请记住，这是硬编码为从 Column B 开始的 Row 6 的输出，因此您需要根据需要调整代码中的这些引用以及输入的位置。