使用可变步长创建 2 个数字之间的值列表

如何解决使用可变步长创建 2 个数字之间的值列表

我试图列出 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,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

解决方法

假设您的工作表是这样设置的，下面的示例将根据您的示例工作表输出。我不知道有什么方法可以在 1 个循环中实现这一点，但您可以按照以下示例将 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

这也在同一个代码模块中使用了这个函数：

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

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