迭代 table 列中所有值的算法

Question

我正在寻找一种适用于以下 table 的简单算法：

在第一列中，您会看到限制条件。算法应该使用第二列来输出迭代，应该这样做：

 0  0  0
 0  0  1
........
 0  0 29
 0  1  0
........
 0  1 29
 0  2  0
 0  2  1
........
........
27  9 29
28  0  0
........
........
28  9 29

目前我有以下代码：

Dim wksSourceSheet As Worksheet
Set wksSourceSheet = Worksheets("Solver")

Dim lngLastRow As Long
Dim lngLastColumn As Long

With wksSourceSheet 
    lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
        .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
    lngLastColumn = IIf(IsEmpty(.Cells(1, .Columns.Count)), _
        .Cells(1, .Columns.Count).End(xlToLeft).Column, .Columns.Count)

    Dim intRowOuter As Integer
    Dim intRowInner As Integer
    For intRowOuter = 2 To lngLastRow
        .Cells(intRowOuter, lngLastColumn).Value = 0
    Next intRowOuter
    For intRowOuter = lngLastRow To 2 Step -1
        For intRowInner = lngLastRow To intRowOuter Step -1
            Dim constraint As Integer
            Dim intConstraintCounter As Integer
            intConstraint = .Cells(intRowInner, 1)
            For intConstraintCounter = 1 To intConstraint 
                .Cells(intRowInner, lngLastColumn).Value = intConstraintCounter
            Next intStampCounter
        Next intRowInner
    Next intRowOuter
End With

这可能是一种正确的方法，但有些地方不正确。不幸的是，我被卡住了，所以如果能帮我解决这个问题，我将不胜感激。

Answer 1

x%10 或 x Mod 10 给出 x 除以 10 的余数，得到 x 的最后一位。

因为你的问题是明确要求每个数字不超过 463857。你可以有一个从 000000 递增到 463857 的计数器，并且只有 output/use 个数字满足以下条件：

IF(x%10 <= 7 AND x%100 <=57 AND x%1000 <= 857 AND x%10000 <=3857 AND x%100000 <= 63857 AND x <= 463857) 
THEN //perform task.

Answer 2

解决方案

我建议使用一个数组来存储约束，一个数组来表示计数器。

Dim MaxNum() As Long
Dim myCounter() As Long
ReDim MaxNum(1 To NumDigits)
ReDim myCounter(1 To NumDigits)

接下来需要初始化MaxNum。这可能涉及遍历包含约束的单元格。类似于：

Dim constraintRange As Range
Dim i As integer

Set constraintRange = wksSourceSheet.Range("A2:A4")
For i = 1 to numDigits
    MaxNum(i) = constraintRange.Cells(i,1).Value
Next i

现在我们只需要写一个增量计数器函数就可以了！这个想法非常简单，我们只是从最低有效数字到最高有效数字。我们递增 LSD，如果有溢出，我们将其设置为 0，然后将 1 加到下一位。它看起来像这样：

Sub IncrNum(ByRef myNum() As Long, ByRef MaxNum() As Long) 
    Dim i As Integer
    For i = LBound(myNum) To UBound(myNum)
        myNum(i) = myNum(i) + 1
        If myNum(i) > MaxNum(i) Then 'Overflow!
            myNum(i) = 0 'Reset digit to 0 and continue 
        Else
            Exit For 'No overflow so we can just exit
        End If
    Next i
End Sub

这只是一个for循环！我认为这将是最干净的解决方案:)

注意：要使用此功能，您只需执行 IncrNum(myCounter, MaxNum)。这会将 myCounter 的值更改为序列中的下一个。从这里您可以通过 dstRange = myCounter 粘贴到一个范围。

测试

在我自己的测试中，我使用了一个 while 循环来打印出所有的值。它看起来像这样：

Do While Not areEqual(MaxNum, myCounter)
    Call IncrNum(myCounter,MaxNum)
    outRange = myCounter
    Set outRange = outRange.Offset(1, 0)
Loop

areEqual 只是一个函数，如果参数包含相同的值，则 returns 为真。如果您愿意，我可以提供我的代码，否则我会将其保留下来，以尽可能保持我的回答正确。

Answer 3

也许可以修改类似的内容以满足您的需要。它用进位模拟加法：

Sub Clicker(MaxNums As Variant)
    Dim A As Variant
    Dim i As Long, j As Long, m As Long, n As Long
    Dim sum As Long, carry As Long
    Dim product As Long

    m = LBound(MaxNums)
    n = UBound(MaxNums)
    product = 1
    For i = m To n
        product = product * (1 + MaxNums(i))
    Next i
    ReDim A(1 To product, m To n)

    For j = m To n
        A(1, j) = 0
    Next j

    For i = 2 To product
        carry = 1
        For j = n To m Step -1
            sum = A(i - 1, j) + carry
            If sum > MaxNums(j) Then
                A(i, j) = 0
                carry = 1
            Else
                A(i, j) = sum
                carry = 0
            End If
        Next j
    Next i
    Range(Cells(1, 1), Cells(product, n - m + 1)).Value = A
End Sub

像这样使用：

Sub test()
    Clicker Array(3, 2, 2)
End Sub

产生：

迭代 table 列中所有值的算法

An algorithm for iteration over all values in a column of a table

iteration

algorithm

vba

loops

brute-force

解决方案

测试