在具有可变步长的 2 个数字之间创建值列表

Create a list of values between 2 numbers with a variable step size

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

假设您的 sheet 是这样设置的,下面的示例将根据您的示例作品sheet 输出。我不知道有什么方法可以在 1 个循环中实现这一点,但您可以按照以下示例并将 2 个或更多循环合并到您的例程中,重复使用第二个示例方法。

注意:这些例子写在新作品sheet新工作簿中。 workbook/worksheets没有限定,默认为'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 的增量提供输出。


现在,如果我们想让它更动态一点,我们可以使用变量或范围引用来引用您 sheet 的 'Inputs' 部分,如下所示:

'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

两组示例都在做完全相同的事情,只有第二组可以让您通过更新工作的 'Input' 范围来更改循环的标准sheet(低,高和间隔单元格)。


避免单独循环

这是假设输入的布局与示例数据中的布局相同;在不知道数据的来龙去脉的情况下,很难编写出 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 个输入和一个新输入对其进行了测试,结果按预期输出:

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