在具有可变步长的 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
的硬编码输出,因此您需要根据需要调整代码中的这些引用以及输入的位置。
我试图列出 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
的硬编码输出,因此您需要根据需要调整代码中的这些引用以及输入的位置。