我的代码中的逻辑错误

Question

我写了下面的代码，其中我必须首先识别最小的、第二小的等等数字，然后获取它们的行号（我将行号保存在单独的列中，这里是第 50 列，如果有多个这样的数字）并按照行号的顺序将内容从一列（这里是第 2 列）复制到另一列（这里是第 7 列），即首先是最小的，然后是第二小的，依此类推。

每43行开始就有172个这样的数据集

这将一直持续到新列（每个数据集的第 7 列的 45 行）（数据被复制到的）中的数字总和小于指定的数字（45 行每个数据集中的第 1 列，即 A45 然后 A88)

编辑：上面比较的总和，即 G45 与 A45 的比较是通过 sheet 本身的公式

Dim m As Range, cl As Range, k As Double, b As Double, lIndex As Double, a As Double, multi As Double, l As Integer, x As Double

Set m = ActiveSheet.Range("E3:E40")
multi = 2                                                              'To move to starting position of the data set

For i = 1 To 172
    b = 45 + 43 * (i - 1)

    For k = 1 To 38
        a = Application.Small(m, k) 'To find the kth smallest number
        l = 1
        For j = 1 To 38             'To store the matching row numbers (Multiple instances) in column 50
                Cells(j, 50).Value = 0                                     'Initializing to column no. 50 to 0
                If Cells(j + multi, 5).Value = a Then                      'Checking for match
                    Cells(l, 50).Value = j + multi                         'Storing Row coordinates in column no. 50
                    l = l + 1
                End If
            Next j

 '==============THE FOLLOWING IS THE AREA WHERE THE PROBLEM MIGHT BE====================== 


        For o = 1 To l - 1 'To Copy the values based on the criteria
            x = Cells(o, 50).Value
            If Cells(b, 7).Value <= Cells(b, 1).Value Then             '"CRITERIA" Checking whether sum of the column is less than or equal to sum of first column of set
                Cells(x, 7).Value = Cells(x, 2).Value
            End If
        Next o

    Next k

    Set m = m.Offset(43)
    multi = multi + 43
Next i

问题是复制副本的条件（总和应小于一定值）不工作。它实际上将所有数据从第 2 列复制到第 7 列。

谁能帮忙找出这可能是什么原因...

注意：我检查并确认在第 50 列中存储行号的代码工作正常。所以问题可能出在代码的下半部分，即带有变量 "o"

的 for 循环

Answer 1

我继续自己推动这个。

意识到有多个错误：

我不得不将新列初始化为 0。我错过了。由于某些原因，将列从 7 更改为 6。
当达到标准时，我没有退出主 for 循环，因为即使在该过程应该完成之后，该过程仍在继续。为此使用了布尔变量标志。
在计算小函数给定值重复的迭代次数时，变量"l"被计为1+1。做了适当的调整。（由于某种原因将列从 50 更改为 500）
我观察到 Excel 并没有自行更新计算值，所以在开头包含了 Application.Calculate 函数。

这是工作代码：

Application.Calculate
Dim m As Range, cl As Range, k As Double, b As Double, lIndex As Double, a As Double, multi As Double, l As Double, x As Double, Check As Double, flag As Boolean
    l = 2
    Set m = ActiveSheet.Range("E3:E40")
    multi = 2                                                             'To move to starting position of the data set
    flag = False

    For i = 1 To 172

        b = 45 + 43 * (i - 1)
        Cells(b, 6).Value = 0

        For p = 3 To 40

            Cells(p + ((i - 1) * 43), 6).Value = 0                               'Initializing to column no. 6 to 0

        Next p

        For k = 1 To 38

            If flag = True Then
            flag = 0
            Exit For
            End If

            If k + l - 2 <= 38 Then
                a = Application.Small(m, (k + l - 2))
                k = k + l - 2
            Else
                Exit For
            End If

            l = 1

            For j = 1 To 38

                Cells(j, 500).Value = 0                                     'Initializing to column no. 500 to 0

                If Cells(j + multi, 5).Value = a Then                      'Checking for match
                    Cells(l, 500).Value = j + multi                         'Storing Row coordinates in column no. 500
                    l = l + 1
                End If

            Next j

            For o = 1 To l - 1

                x = Cells(o, 500).Value
                Cells(x, 6).Value = 0
                Cells(b, 6).Value = Cells(b, 6).Value + Cells(x, 2).Value
                Check = Cells(b, 6).Value
                If Cells(b, 6).Value <= Cells(b, 1).Value Then             'Checking whether sum of the column is less than or equal to sum of first column of set
                    Cells(x, 6).Value = Cells(x, 2).Value
                Else:
                    Cells(x, 6).Value = Cells(b, 1).Value - (Cells(b, 6).Value - Cells(x, 2).Value)
                    Cells(b, 6).Value = Cells(b, 6).Value - Cells(x, 2).Value + Cells(x, 6).Value
                    flag = True
                Exit For
                End If

            Next o

        Next k

        Set m = m.Offset(43)
        multi = multi + 43

    Next i

End Sub

我的代码中的逻辑错误

Logical Error in my code

excel

excel-formula

excel-2016

vba